Excel 復制到 Word VBA

Question

我有一些代碼正在使用宏記錄器進行處理。 一句話，它總是以選擇開始。 這篇文章https://exceloffthegrid.com/controlling-word-from-excel-using-vba/?unapproved=9388&moderation-hash=83a9b85f06d7f960463f59103685510b#comment-9388說我應該能夠將此文檔分配給一個變量並插入在.選擇之前。 但是，在我鍵入文檔變量后，選擇方法不會出現在 VBE 中。 在我第一次使用單詞選擇對象 (Selection.EndKey) 時，我收到運行時錯誤 438“對象不支持此屬性或方法”。 據我所知，GoTo 方法應該選擇標題的開頭。

Sub ExcelToWord()
'
' Select data in excel and copy to GIR
'
'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
 
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wdApp As Word.Application
    Dim GIR As Word.Document
    Dim GIRName As String
    Dim GEOL As String
    Dim Tbl As Long
        
    Set wdApp = New Word.Application '<<<  Create a Word application object
    wdApp.Visible = True '<<<< Open word so you can see any errors
    
    GIRName = Application.GetOpenFilename(Title:="Please choose GIR to open", _
                                          FileFilter:="Word Files *.docm* (*.docm*),")
    Set GIR = wdApp.Documents.Open(GIRName) '<< call Documents.Open on the word app
    
    'Loop through excel workbook to copy data
    Set wb = ThisWorkbook
    Set ws = ActiveSheet
    For Each ws In wb.Worksheets
        If UCase(ws.Name) <> "TEMPLATE" And ws.Visible = True Then
            ws.Name = Replace(ws.Name, "(Blank)", "NoGEOLCode")
            ws.Activate
            GEOL = Range("C9").Value
            Tbl = 1
            Range("A14").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            
            'Paste each worksheet's data into word as new heading
            GIR.Activate
            GIR.Content.GoTo What:=wdGoToHeading, Which:=wdGoToFirst, Count:=5, Name:=""
            Selection.EndKey Unit:=wdLine
            Selection.TypeParagraph
            Selection.Style = ActiveDocument.Styles("Heading 2")
            Selection.TypeText Text:=GEOL
            Selection.TypeParagraph
            Selection.Tables.Add Range:=Selection.Range, NumRows:=53, NumColumns:=7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitWindow
            With Selection.Tables(Tbl)
                If .Style <> "Table1" Then
                    .Style = "Table1"
                End If
                .ApplyStyleHeadingRows = True
                .ApplyStyleLastRow = False
                .ApplyStyleFirstColumn = True
                .ApplyStyleLastColumn = False
                .ApplyStyleRowBands = True
                .ApplyStyleColumnBands = False
            End With
            Selection.PasteAndFormat (wdFormatPlainText)
            Tbl = Tbl + 1
            Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=6, Name:=""
            Selection.MoveUp Unit:=wdLine, Count:=1
            Selection.TypeParagraph
        End If
    Next
    
    GIR.Save
    
    
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
   
    
End Sub

Answer 1

您的代碼有幾個問題。

1. 出於各種原因使用Selection對象是不好的做法。 最好在 Excel 和 Word 中改用Range 。
2. 您將變量GIR設置為您打開的文檔，但隨后改用ActiveDocument 。
3. 您將表格添加到以標題 2樣式設置格式的段落中。 要使表格樣式正常工作，基礎段落樣式必須為Normal 。 這是因為 Word 中有一個樣式層次結構，底部是表格樣式，就在文檔默認值之上，由Normal表示。
4. 您將變量NewTbl設置為指向您創建的表，但不再使用它。
5. With wdApp.Selection.Tables(Tbl)會出錯，因為Selection只有一張表。

我已經重寫了你的代碼如下。 我沒有更改 Word 代碼的最后 3 行，因為我不確定您在那里到底在做什么，這是在沒有處理文檔的情況下嘗試調試代碼的結果。 我已經使用一些虛擬數據測試了這段代碼，它在 O365 中對我有用。

Sub ExcelToWord()
  '
  ' Select data in excel and copy to GIR
  '
  '
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim wdApp As Word.Application
  Dim GIR As Word.Document
  Dim GIRName As String
  Dim GEOL As String
  Dim Tbl As Long
  Dim NewTbl As Word.Table
  Dim wdRange As Word.Range
  
  Set wdApp = New Word.Application '<<<  Create a Word application object
  wdApp.Visible = True '<<<< Open word so you can see any errors
  
  GIRName = Application.GetOpenFilename(Title:="Please choose GIR to open", _
    FileFilter:="Word Files *.docm* (*.docm*),")
  Set GIR = wdApp.Documents.Open(GIRName) '<< call Documents.Open on the word app
  
  'Loop through excel workbook to copy data
  Set wb = ThisWorkbook
  Set ws = ActiveSheet
  For Each ws In wb.Worksheets
    If UCase(ws.Name) <> "TEMPLATE" And ws.Visible = True Then
      ws.Name = Replace(ws.Name, "(Blank)", "NoGEOLCode")
      ws.Activate
      GEOL = Range("C9").Value
      Tbl = 1
      Range("A14").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
            
      'Paste each worksheet's data into word as new heading
            
      Set wdRange = wdApp.Selection.GoTo(What:=wdGoToHeading, _
        Which:=wdGoToFirst, Count:=4, Name:="")
      With wdRange
        '      wdApp.Selection.EndKey Unit:=wdLine
        '      wdApp.Selection.TypeParagraph
        .End = .Paragraphs(1).Range.End
        .InsertParagraphAfter
        .MoveStart wdParagraph
        .MoveEnd wdCharacter, -1
        '      wdApp.Selection.Style = ActiveDocument.Styles("Heading 2")
        .Style = GIR.Styles(wdStyleHeading2)
        '      wdApp.Selection.TypeText Text:=GEOL
        .Text = GEOL
        '      wdApp.Selection.TypeParagraph
        .InsertParagraphAfter
        .Collapse wdCollapseEnd
        .Style = GIR.Styles(wdStyleNormal)
        Set NewTbl = GIR.Tables.Add(Range:=wdRange, NumRows:=53, _
          NumColumns:=7, DefaultTableBehavior:=wdWord9TableBehavior, _
          AutoFitBehavior:=wdAutoFitWindow)
        '    With wdApp.Selection.Tables(Tbl)
        With NewTbl
          If .Style <> "Table1" Then
            .Style = "Table1"
          End If
          .ApplyStyleHeadingRows = True
          .ApplyStyleLastRow = False
          .ApplyStyleFirstColumn = True
          .ApplyStyleLastColumn = False
          .ApplyStyleRowBands = True
          .ApplyStyleColumnBands = False
          .Range.PasteAndFormat wdFormatPlainText
        End With
        '    wdApp.Selection.PasteAndFormat (wdFormatPlainText)
        '    Tbl = Tbl + 1
        wdApp.Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, _
          Count:=6, Name:=""
        wdApp.Selection.MoveUp Unit:=wdLine, Count:=1
        wdApp.Selection.TypeParagraph
      End With
    End If
  Next
    
  GIR.Save
    
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
   
End Sub