Excel复制到Word VBA [英] Excel copy to Word VBA

问题描述

我有一些正在使用宏记录器的代码.换句话说，它总是以选择开始.本文 https ://exceloffthegrid.com/controlling-word-from-excel-using-vba/?unapproved = 9388& moderation-hash = 83a9b85f06d7f960463f59103685510b#comment-9388 说我应该能够将文档分配给变量，然后只需在.Selection之前插入即可.但是，在我输入文档变量后，选择方法不会在VBE中出现.我第一次使用单词Selection对象(Selection.EndKey)时遇到运行时错误438对象不支持此属性或方法".据我所知，GoTo方法应选择标题的开始.

I have some code that I am working on with the macro recorder. In word it always begins with Selection. This article https://exceloffthegrid.com/controlling-word-from-excel-using-vba/?unapproved=9388&moderation-hash=83a9b85f06d7f960463f59103685510b#comment-9388 says I should be able to assign the document to a variable and just insert this before .Selection. However the selection method doesn't appear in VBE for me after I type my document variable. I get a run time error 438 'object doesn't support this property or method' on my first use of the word Selection object (Selection.EndKey). As far as I can see the GoTo method should select the start of the heading.

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

推荐答案

您的代码有几个问题.

1. 出于各种原因，使用Selection对象是一种不好的做法.最好在Excel和Word中都使用Range.
2. 您将变量GIR设置为打开的文档，但改为使用ActiveDocument.
3. 您将表格添加到以 Heading 2 样式设置的段落中.为了使表格样式正常工作，基础段落样式必须为 Normal .这是因为在

1. It is bad practice to use the Selection object for various reasons. It is better to use Range instead, both in Excel and Word.
2. You set the variable GIR to the document you opened but then use ActiveDocument instead.
3. You add your table into a paragraph formatted with Heading 2 style. For table styles to work correctly the underlying paragraph style must be Normal. This is because there is a hierarchy of styles in Word with table styles at the bottom, just above document default which is represented by Normal.
4. You set the variable NewTbl to point to the table you created but make no further use of it.
5. The line With wdApp.Selection.Tables(Tbl) will error as there will only be one table in the Selection.

我已按如下方式重写了您的代码.我不确定Word的最后3行保持不变，因为我不确定您在做什么，这是尝试在不处理文档的情况下调试代码的结果.我已经使用一些虚拟数据测试了此代码，它在O365中对我有用.

I have rewritten your code as below. I have left the final 3 lines of Word code unaltered as I am unsure exactly what you are doing there, a consequence of attempting to debug code without the document being worked on. I have tested this code using some dummy data and it works for me in 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

这篇关于Excel复制到Word VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！