web-dev-qa-db-ja.com

HTMLテーブルをExcelに貼り付け、セルの改行を維持する方法

たとえば、セルが1つだけの単純なhtmlテーブルがありますが、domノードをコピーしてExcelに貼り付けると、2つの行として認識されます。Excelで正しい貼り付けデータを取得する方法.

 <table><tr><td>1<br>2</td><tr></table>

CSSスタイルを追加しようとしました

br {mso-data-placement:same-cell;},

ただし、IEでのみ機能します。

プレーンテキストをコピーするのは問題です。セルに色、フォント情報を追加する必要があります。

21
virsir

ご存じの方も多いと思いますが、正しいcontent-typeとcontent-dispositionヘッダーを追加するだけで、データ(レポートなど)をExcelファイルとして出力できます。

Response.ContentType = “application/vnd.ms-Excel“;

Response.AppendHeader(“content-disposition“, “inline; filename=report.xls“);

クライアントにMS Excelがインストールされている場合、出力HTMLページはWebブラウザーではなくクライアントで開かれます。 Excelはすべての書式(境界線、フォントなど)とTABLEタグを解釈します。これにより、サーバー側の重いコントロールを使用しなくても、適切な書式のワークシートを作成できます。

私がしばらくの間苦労していた問題は、複数行のセルに関するものでした。テキストをセルで折り返す必要がありましたが、<br>タグをHTML出力に挿入すると、Excelは既存のセルの改行ではなく、新しい行として解釈します。

スタイルシートに追加:

br {mso-data-placement:same-cell;}

それからそれは魅力のように働きます。私はそれが役に立てば幸いです:)

ヒント:ContentTypeとヘッダーを条件付きにして、1つのファイルで代替のHTML/XLSレポートを提供できます。

19
Himanshu padia

Firefoxはmso-data-placementディレクティブを完全に無視しているようです。 Firebugスタイルのパネルには表示されません。おそらくそれが期待どおりに貼り付けられない理由ですか?

3
benshepherd

マクロを使用してどうですか?次のコード?

TransformingPaste1():ただし、これは私のマシンでは失敗します(まだ複数のセル)

  • クリップボードのテキストを取得します
  • _mso-data-placement:same-cell_を使用して変換されたバージョンを貼り付けます
  • 元のクリップボードのテキストを復元します

TransformingPaste2():自分のマシンの単一のセルに貼り付け、書式設定などを維持しますが、HTMLを貼り付けているため、改行ではなくスペースが生じます

  • クリップボードのテキストを取得します
  • vbCrLfを使用して変換されたバージョンを貼り付けます
  • 元のクリップボードのテキストを復元します

TransformingPaste3():マシンの単一セルに改行を付けて貼り付けますが、書式設定などが失われます(現在の実装)–リンク付きのメモを参照してください!

  • クリップボードのテキストを取得します
  • 自己定義トークンを使用して変換されたバージョンを貼り付けます
  • 元のクリップボードのテキストを復元します
  • セルを後処理し、トークンを改行で置き換えます–改善される可能性があります…

たとえば、ニーズに最適なものに変更します。正規表現を使用して置換を実行しますが、これであなたがあなたの道を進むことを願っています:]

_Function GetClipboardText() As String
    Dim BufObj As MSForms.DataObject
    Set BufObj = New MSForms.DataObject
    BufObj.GetFromClipboard
    GetClipboardText = BufObj.GetText
End Function

Function SetClipboardText(ByRef text As String)
    Dim BufObj As MSForms.DataObject
    Set BufObj = New MSForms.DataObject
    BufObj.SetText text
    BufObj.PutInClipboard
End Function

Function PreProcess(ByRef text As String, ByRef find As String, ByRef replace As String) As String
    PreProcess = Application.WorksheetFunction.Substitute(text, find, replace)
End Function

Function PostProcess(ByRef find As String, ByRef replace As String)
    Dim rCell As range
    For Each rCell In Selection
        'TODO: e.g. combine with answers from http://stackoverflow.com/questions/2192730/merge-contents-of-2-Excel-cells-keeping-character-format-intact-using-vba
        rCell.Formula = Application.WorksheetFunction.Substitute(rCell.Formula, find, replace)
    Next
End Function

Sub TransformingPaste1()
    Dim OrigText As String
    Dim TempToken As String
    Dim PasteText As String
    Dim sSelAdd As String
    OrigText = GetClipboardText
    PasteText = PreProcess(OrigText, "<html>", "<html><style>br{mso-data-placement:same-cell;}</style>")
    SetClipboardText PasteText
    'Selection.PasteSpecial "Unicode Text"
    ActiveSheet.Paste
    SetClipboardText OrigText
    Application.CutCopyMode = False
End Sub

Sub TransformingPaste2()
    Dim OrigText As String
    Dim TempToken As String
    Dim PasteText As String
    Dim sSelAdd As String
    OrigText = GetClipboardText
    PasteText = PreProcess(OrigText, "<br>", vbCrLf)
    SetClipboardText PasteText
    ActiveSheet.Paste
    SetClipboardText OrigText
    Application.CutCopyMode = False
End Sub

Sub TransformingPaste3()
    Dim OrigText As String
    Dim TempToken As String
    Dim PasteText As String
    Dim sSelAdd As String
    OrigText = GetClipboardText
    TempToken = "#mybr#"
    PasteText = PreProcess(OrigText, "<br>", TempToken)
    SetClipboardText PasteText
    ActiveSheet.Paste
    SetClipboardText OrigText
    PostProcess TempToken, vbLf
    Application.CutCopyMode = False
End Sub
_
1
mousio

コピーと貼り付けが本当に必要な場合は、データをコピーする前に、Excelシートで「セルのプロパティ」を編集することをお勧めします。 Excelで列名を右クリックし、セルのプロパティを選択します。データに応じて変更を加えて保存します。これで、データをコピーして、MS-Excelで正しく解釈されることを期待できます。ただし、HTMLコンテンツには使用していません。

0
Anurag