Excel复制到Word VBA

我有一些代码，我正在与宏记录器工作。换句话说，它总是从选择开始。这篇文章说我应该能够将文档分配给一个变量，然后在前面插入这个变量。但是，键入文档变量后，选择方法不会显示在VBE中。我第一次使用单词Selection对象（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

Sub-ExcelToWord（）
'
'在excel中选择数据并复制到GIR
'
'
Application.ScreenUpdating=False
Application.EnableEvents=False
Application.Calculation=xlCalculationManual
将wb设置为工作簿
将ws设置为工作表
将wdApp设置为Word.Application
Dim GIR作为Word.Document
将名称设置为字符串
将土工合成细绳
变暗Tbl尽可能长
Set wdApp=New Word.Application'您的代码有几个问题

出于各种原因使用
选择
对象是不好的做法。最好在Excel和Word中使用
范围
将变量
GIR
设置为打开的文档，然后改用
ActiveDocument
将表格添加到标题2样式的段落中。要使表格样式正常工作，基础段落样式必须是正常的。这是因为在底部有一个带有表格样式的in-Word，就在文档默认值的正上方，该默认值由Normal表示
将变量
NewTbl
设置为指向您创建的表，但不进一步使用它
带有
wdApp.Selection.Tables（Tbl）
的行将出错，因为
选择中只有一个表

我已经重写了你的代码如下。我没有改变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

Sub-ExcelToWord（）
'
'在excel中选择数据并复制到GIR
'
'
Application.ScreenUpdating=False
Application.EnableEvents=False
Application.Calculation=xlCalculationManual
将wb设置为工作簿
将ws设置为工作表
将wdApp设置为Word.Application
Dim GIR作为Word.Document
将名称设置为字符串
将土工合成细绳
变暗Tbl尽可能长
如Word.Table所示
将wdRange设置为Word.Range
Set wdApp=New Word.Application'请使用问题下方的编辑链接并提供更多详细信息：哪一行给出了错误；错误消息的文本是什么；出现错误时在Word文档中选择的内容。由于此代码托管在Excel中，
Selection
本身指的是Excel版本，当然它没有Word属性/方法。要获得Word版本，请使用
wdApp.Selection
感谢@chrisneilsen解决了我的第一个问题。我现在对从word宏记录器复制来添加表的代码有一个问题。