Word 宏用于打开 Excel 文件、复制 Excel 表格和在 Word 文档末尾粘贴表格

Question

我正在寻找一个宏，它可以打开文件对话框，允许用户选择他们的表格（表格大小都相同），然后自动将该表格粘贴到他们的 Word 文档的末尾。

我可以编辑 VBA 代码，但不擅长创建它。其中大部分是从我在这里找到的随机样本中提取的。我在以下位置遇到错误：

设置 oExcelWorkBook = oExcelApp.Workbooks.Open (fileName)

这是我正在使用的完整代码：

Sub MakeTablefromExcelFile()
'advanced
Dim oExcelApp, oExcelWorkbook, oExcelWorksheet, oExcelRange
Dim nNumOfRows As Long
Dim nNumOfCols As Long
Dim directory As String, fileName As String, oExcelWorksheet As Worksheet, total As Integer
Dim fd As Office.FileDialog
    
Dim oTable As Table    'word table
Dim oRow As Row    'word row
Dim oCell As Cell    'word table cell
Dim x As Long, y As Long    'counter for loops


Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
    .AllowMultiSelect = False
    .Title = "Please select your publishing table"
    .Filters.Clear
            
    If .Show = True Then
    fileName = Dir(.SelectedItems(1))
    
    End If
End With
    
Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
Set oExcelWorkbook = oExcelApp.Workbooks.Open(fileName)    'open workbook and asign it to variable
Set oExcelWorksheet = oExcelWorkbook.Worksheets(1)    'asign first worksheet to variable
Set oExcelRange = oExcelWorksheet.Range("A1:F31")
nNumOfRows = oExcelRange.Rows.Count
nNumOfCols = oExcelRange.Columns.Count

ActiveDocument.Range.InsertParagraphAfter    'just makes new paragraph at the end of doc, Table will be created here
Set oTable = ActiveDocument.Tables.Add(Range:=ActiveDocument.Paragraphs.Last.Range, NumRows:=nNumOfRows, NumColumns:=nNumOfCols)    'create table and asign it to variable
'***real deal, table gets filled here
For x = 1 To nNumOfRows
    For y = 1 To nNumOfCols
        oTable.Cell(x, y).Range.Text = oExcelRange.Cells(x, y).Value
    Next y
Next x
'***
oExcelWorkbook.Close False
oExcelApp.Quit
With oTable
    .Range.Font.Size = 9
    .Columns(1).Width = 225
    .Columns(2).Width = 75
    .Columns(3).Width = 60
    .Columns(4).Width = 60
    .Columns(5).Width = 60
    .Columns(6).Width = 60
    .Rows.Height = 20
End With

结束子 '''

感谢您的帮助

Answer 1

我找到了解决我遇到的大多数问题的解决方案。不过，我仍然在 VBA for Word 中计算列数时遇到了一个小问题

Sub MakeTablefromExcelFile()
'
Dim oExcelApp, oExcelWorkbook, oExcelWorksheet, oExcelRange
Dim nNumberOfRows As Integer
Dim nNumberOfCols As Integer
Dim directory As String, fileName As String, fileFolder As String, total As 
Integer
Dim fd As Office.FileDialog

Dim oTable As Table    'word table
Dim oRow As Row    'word row
Dim oCell As Cell    'word table cell
Dim x As Long, y As Long    'counter for loops

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
    .InitialView = msoFileDialogViewThumbnail
    .AllowMultiSelect = False
    .Title = "Please select your publishing table"
    .InitialFileName = fileFolder
    .InitialView = msoFileDialogViewThumbnail
    .Filters.Clear
    
If .Show = True Then
    fileName = .SelectedItems(1)
    
End If
End With

Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
Set oExcelWorkbook = oExcelApp.Workbooks.Open(fileName)
Set oExcelWorksheet = oExcelWorkbook.Worksheets(1)    'asign first worksheet to variabl
Set oExcelRange = oExcelWorksheet.Range("A1:F31")
nNumberOfRows = oExcelRange.Rows.Count
nNumberOfCols = oExcelRange.Columns.Count

ActiveDocument.Range.InsertParagraphAfter    'just makes new paragraph at the end of doc, Table will be created here
Set oTable = ActiveDocument.Tables.Add(Range:=ActiveDocument.Paragraphs.Last.Range, NumRows:=nNumberOfRows, NumColumns:=nNubmerOfCols)    'create table and asign it to variable
'***real deal, table gets filled here
For x = 1 To nNumberOfRows
For y = 1 To nNumberOfCols
    oTable.Cell(x, y).Range.Text = oExcelRange.Cells(x, y).Value
Next y
Next x
'***
oExcelWorkbook.Close False
oExcelApp.Quit

With oTable
.Range.Font.Size = 9
.AutoFitBehavior _
    wdAutoFitWindow

End With

End Sub