vba - VBマクロを使用してWordテーブルからExcelシートにデータをコピーする際にソースフォーマットを保持する方法は?

Question

VB マクロを使用して、Word テーブルから Excel シートにデータをコピーしようとしています。

希望どおりにテキストを完全にコピーしています。

ここで、Word doc に存在するソースの書式設定を保持したいと考えています。

守りたいものは

ストライクスルー
色
弾丸
改行文字

次のコードを使用してコピーしています-

objTemplateSheetExcelSheet.Cells(1, 2) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)

ソースのフォーマットを維持するためにこれを編集する方法を教えてください。

私が使用しているロジックは次のとおりです-

wdFileName = Application.GetOpenFilename("Word files (*.*),*.*", , _
"Browse for file containing table to be imported") '(Browsing for a file)

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) '(open Word file)

With wdDoc
    'enter code here`
    TableNo = wdDoc.tables.Count '(Counting no of tables in the document)
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    End If
End With

Wordファイルでテーブルカウントを実行しています。次に、単語 doc に存在するすべてのテーブルに対して、上記のコードを使用してテーブルの各行と列にアクセスします。

OK、残りのコードも添付します

'Creating TemplateSheet object
Set objTemplateSheetExcelApp = CreateObject("Excel.Application")
'Opening the template to be used
objTemplateSheetExcelApp.Workbooks.Open ("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")
Set objTemplateSheetExcelWkBk = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5)
Set objTemplateSheetExcelSheet = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5) '(Selecting the desired tab)

tblcount = 1
For tblcount = 1 To TableNo
    With .tables(tblcount)
    'copy cell contents from Word table cells to Excel cells
    For iRow = 1 To .Rows.Count
        For iCol = 1 To .Columns.Count
            On Error Resume Next
            strEach = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            For arrycnt = 0 To 15
                YNdoc = InStr(strEach, myArray(arrycnt))
                    If (YNdoc > 0) Then
                        objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt)) = _
                        WorksheetFunction.Clean(.cell(iRow, iCol + 1).Range.Text)
                            If arrycnt = 3 Or arrycnt = 6 Then
                                objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt) + 1) = _
                                WorksheetFunction.Clean(.cell(iRow + 1, iCol + 1).Range.Text)
                            End If
                    End If
            Next arrycnt
        Next iCol
    Next iRow
    End With
    Next tblcount
End With
intRow = 1

'To save the file
strFileName = "Newfile.xlsx"
objTemplateSheetExcelWkBk.SaveAs strFld & "\" & strFileName

objTemplateSheetExcelApp.Quit

Set objTemplateSheetExcelApp = Nothing
Set objTemplateSheetExcelWkBk = Nothing
Set objTemplateSheetExcelSheet = Nothing

Set wdDoc = Nothing

score 8 · Accepted Answer

Excel から Word を操作するには、事前バインディングまたは遅延バインディングのいずれかを選択できます。参照を追加する必要のない遅延バインディングを使用しています。

コードを 5 つの部分に分けて説明します

Word インスタンスとのバインディング
Word文書を開く
Word テーブルの操作
Excel オブジェクトの宣言
Word の表を Excel にコピーする

A. Word インスタンスとのバインド

Word オブジェクトを宣言してから、Word の既存のインスタンスとバインドするか、新しいインスタンスを作成します。例えば

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True
End Sub

B. Word 文書を開く

Word インスタンスに接続/作成したら、Word ファイルを開くだけです。この例を参照してください。

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    '~~> Open the Word document
    Set oWordDoc = oWordApp.Documents.Open(FlName)
End Sub

C. Word テーブルの操作

これでドキュメントが開いたので、word ドキュメントの Table1 と接続してみましょう。

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)
End Sub

D. Excel オブジェクトの宣言

これで、Word テーブルへのハンドルができました。コピーする前に、Excel オブジェクトを設定しましょう。

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)

    '~~> Excel Objects
    Dim wb As Workbook, ws As Worksheet

    Set wb = Workbooks.Open("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")

    Set ws = wb.Sheets(5)
End Sub

E. Word の表を Excel にコピーする

最後に、宛先をすべて設定したら、表を Word から Excel にコピーするだけです。これを参照してください。

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)

    '~~> Excel Objects
    Dim wb As Workbook, ws As Worksheet

    Set wb = Workbooks.Open("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")

    Set ws = wb.Sheets(1)

    tbl.Range.Copy

    ws.Range("A1").Activate

    ws.Paste
End Sub

スクリーンショット

ワード文書

ここに画像の説明を入力

Excel（貼り付け後）

ここに画像の説明を入力

お役に立てれば。

vba - VBマクロを使用してWordテーブルからExcelシートにデータをコピーする際にソースフォーマットを保持する方法は?

ソースのフォーマットを維持するためにこれを編集する方法を教えてください。

1 に答える 1

Related

Reference