名前 題名 ▼ snailさん > ▼ Mr.XRAYさん > > 恐ろしや、あっという間に１ヶ月たちました。 > > > これは，あくまでも，エクセル側で [貼り付け] 操作をした時に， > > 書式も反映させるためです． > > マスターの例では書かれているとおりで、形式が TEXT のため > LibreOffice では正しく表示できませんでした。 > EXCEL はなんと HTML ヘッダが無くても表示してしまいます。 > HTMLフォーマットにするため色々なところからパクって修正したソースを > 貼り付けておきます。 > 想定した使用例は StringGrid の内容をクリップボードに貼り付けます。 > なお LibreOffice で実行するとタイトル行にゴミが付きます。 > これは LibreOffice のバグ？と思います。 > > あとクリップボードの確認には「クリップ見え窓」というソフトを利用させて > いただきました。作者の方に感謝します。 > http://www.officedaytime.com/clipmm/ > > 注意： > 変数名に「日本語」が入っているため XE2 以上でないとコンパイルできません。 > > unit Unit7; > > interface > > uses > Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, > Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, EditGrid, Vcl.Buttons, > Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Clipbrd, Vcl.DBGrids; > > type > TClipboardAccess = class( TClipboard ) > end; > > procedure Cs_StrCellClipHtmlCopy( ArgGrid : TStringGrid; ArgRowEnd : Integer = (-1); ArgCkCol : Integer = (-1) ); > > implementation > > ////////////////////////////////////////////////////////////// > ////////////////////////////////////////////////////////////// > ////////////////////////////////////////////////////////////// > // http://stackoverflow.com/questions/22617990/how-to-create-picture-and-html-formats-all-together-on-the-clipboard > //----------------------------------------------------------------------- > // HTML形式の ClipBord コピー用ヘッダ作成 > //----------------------------------------------------------------------- > procedure Cs_StrCellClipHtmlCopy( ArgGrid : TStringGrid; ArgRowEnd : Integer = (-1); ArgCkCol : Integer = (-1) ); > const > CnsHtmlFrom : String = ( // HTML開始 > '<html>' > ); > CnsHtmlTo : String = ( // HTML終了 > '</html>' > ); > CnsHeadFrom : String = ( // ヘッダ開始 > '<THEAD>' > ); > CnsEtc : String = ( // おまじない > '<!--StartFragment-->' > + ' <table border="1">' > ); > CnsHeadTo : String = ( // ヘッダ終了 > '</THEAD>' > ); > CnsBodyFrom : String = ( // 明細部、ボディ開始 > '<BODY>' > ); > CnsBodyTo : String = ( // 明細部、ボディ終了 > '</BODY>' > ) ; > CnsTableFrom : String = ( // 表＝テーブル、開始 > '<tr>' > ); > CnsTableTo : String = ( // 表＝テーブル、終了 > '</tr>' > ); > CnsCellLeft : String = ( // セル、文字横位置、左寄せ > '<td align="left">' > ); > CnsCellCenter : String = ( // セル、文字横位置、中央 > '<td align="center">' > ); > CnsCellRight : String = ( // セル、文字横位置、右寄せ > '<td align="right">' > ); > CnsCellTo : String = ( // セル、指定終了 > '</td>' > ); > CnsCellFontRedFrom : String = ( // セル、Font色＝赤 > '<font color="#ff0000">' > ); > CnsCellFontRedTo : String = ( // セル、Font指定終了 > '</font>' > ); > > function FormatHTMLClipboardHeader( ArgHTMLText : UTF8String ): AnsiString; > const > CrLf = #13#10; > begin > Result := 'Version:0.9' + CrLf; > Result := Result + 'StartHTML:-1' + CrLf; > Result := Result + 'EndHTML:-1' + CrLf; > Result := Result + 'StartFragment:000081' + CrLf; > Result := Result + 'EndFragment:°°°°°°' + CrLf; > Result := Result + ArgHTMLText + CrLf; > Result := StringReplace( Result, '°°°°°°', Format('%.6d', [ Length( Result ) ]), [] ); > end; > var > CF_HTML: UINT; > SwtFind : Boolean; > WHtmlStr : UTF8String; > WCurrency : Currency; > WCol, WRow, WSize, WCount : Integer; > WStr, WStrWk, WHeadStr, W文字位置 : String; > begin > if ( ArgGrid is TCustomGrid ) = False then exit; > > CF_HTML := RegisterClipboardFormat( 'HTML Format' ); > > > //------------------------------------- > // ClipBord へ渡すデータ作成開始 > //------------------------------------- > WStr := ''; > WStr := WStr + CnsHtmlFrom; // HTML開始 > //------------------------------------- > // ClipBord へ渡すデータ、ヘッダ > //------------------------------------- > WStr := WStr + CnsHeadFrom; // ヘッダ開始 > WStr := WStr + CnsEtc; // おまじない > for WRow := 0 to ( ArgGrid.FixedRows - 1 ) do > begin > WStr := WStr + CnsTableFrom; // 表＝テーブル、開始 > for WCol := 0 to ( ArgGrid.ColCount - 1 ) do > begin > W文字位置 := CnsCellLeft; > > if WCol = 1 then > W文字位置 := CnsCellCenter > else if WCol = 2 then > W文字位置 := CnsCellRight; > WStr := WStr + W文字位置 + UTF8String( ArgGrid.Cells[ WCol, WRow ] ) + CnsCellTo; // セル、指定終了 > end; > WStr := WStr + CnsTableTo; // 表＝テーブル、終了 > end; > WStr := WStr + CnsHeadTo; // ヘッダ終了 > > //--------------------------------------- > // ClipBord へ渡すデータ、ボディ(明細)部 > //--------------------------------------- > if ArgGrid.ColCount <= ArgCkCol then // 列値 <> NULL 確認だが、確認する列が実際の列数より大きい > ArgCkCol := (-1); > WCount := 0; > WStr := WStr + CnsBodyFrom; // 明細部、ボディ開始 > for WRow := ArgGrid.FixedRows to ( ArgGrid.RowCount - 1 ) do > begin > if 0 <= ArgCkCol then // 列値 <> NULL 確認 > begin > if ArgGrid.Cells[ ArgCkCol, WRow ] = '' then > continue; > end; > if 0 < ArgRowEnd then > begin > Inc( WCount ); > if ArgRowEnd < WCount then break; > end > else if ArgRowEnd = (-1) then // 全列空白はSKIP > begin > SwtFind := False; > for WCol := ArgGrid.FixedCols to ( ArgGrid.ColCount - 1 ) do > if ArgGrid.Cells[ WCol, WRow ] <> '' then > begin > SwtFind := True; > break; > end; > if SwtFind = False then continue; > Inc( WCount ); > end; > WStr := WStr + CnsTableFrom; // 表＝テーブル、開始 > for WCol := 0 to ( ArgGrid.ColCount - 1 ) do > begin > W文字位置 := CnsCellLeft; > > if ( ArgGrid is TEditGrid ) = True then > begin > if WCol = 1 then > W文字位置 := CnsCellCenter > else if WCol = 2 then > W文字位置 := CnsCellRight; > {///////////////// TDBGrid の場合はこんな感じで文字表示位置を確認 > if TDBGrid( ArgGrid ).Fields[ WCol ].Alignment = taCenter then > W文字位置 := CnsCellCenter > else if TDBGrid( ArgGrid ).Fields[ WCol ].Alignment = taRightJustify then > W文字位置 := CnsCellRight; > /////} > end; > WStrWk := ArgGrid.Cells[ WCol, WRow ]; > if W文字位置 = CnsCellRight then // 右詰＝マイナス数値の場合は赤色にする。 > begin > WCurrency := StrToIntDef( WStrWk, 0 ); // ←整数以外 , . などがあると駄目 > if WCurrency < 0 then > WStrWk := CnsCellFontRedFrom + WStrWk + CnsCellFontRedTo; // セル、Font指定 > end; > WStr := WStr + W文字位置 + UTF8String( WStrWk ) + CnsCellTo; // セル、指定終了 > end; > WStr := WStr + CnsTableTo; // 表＝テーブル、終了 > end; > WStr := WStr + CnsBodyTo; // 明細部、ボディ終了 > WStr := WStr + CnsHtmlTo; // HTML終了 > > Clipboard.Open; > try > WHtmlStr := FormatHTMLClipboardHeader( WStr ); > WSize := Length( AnsiString( WHtmlStr ) ); > TClipboardAccess( Clipboard).SetBuffer( CF_HTML, PAnsiChar( WHtmlStr )^, WSize + 1); > TClipboardAccess( Clipboard).SetBuffer( CF_TEXT, PAnsiChar( WHtmlStr )^, WSize + 1); > finally > Clipboard.Close; > end; > end; > > end. GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示). (上限122000(120k)バイト) 削除キー Link