novice
08-29-2013, 11:24 AM
The following code works intermittently, and I can not determine what is causing this.
The code is fired from Word 2010 to locate and select an Excel Workbook (2010 .xlsm), Open the Workbook, Copy an Excel Table, and Paste As Nested Table into a table of the original Word document. For some reason, I am not always getting the "Paste As Nested Table" option in Word. The data seems to be on the clipboard, but it's not recognizing that I'm trying to paste within the table (error 4605). Any suggestions are much appreciated as I have searched and searched for similar threads.
I've posted most of the code below because it's probably some issue with my declarations, but the error is on line 44.
[*=1]Dim tbla, tblb As Table
[*=1]Set tbla = ActiveDocument.Tables(1)
[*=1]Set tblb = ActiveDocument.Tables(2)
[*=1]'Find The Workbook
[*=1]Dim xlApp As Excel.Application
[*=1]Dim xlBook As Excel.Workbook
[*=1]Dim xlSheet As Excel.Worksheet
[*=1]Dim dSource As String
[*=1]Dim fd As FileDialog
[*=1]
[*=1]Set fd = Application.FileDialog(msoFileDialogFilePicker)
[*=1]With fd
[*=1] .Title = "Select the Appendices Workbook."
[*=1] .Filters.Clear
[*=1] .Filters.Add "Excel Files", "*.xlsm"
[*=1] .AllowMultiSelect = False
[*=1] If .Show = -1 Then
[*=1] dSource = .SelectedItems(1)
[*=1] Else
[*=1] Exit Sub
[*=1] End If
[*=1]End With
[*=1]'Open The Workbook and define the sheet
[*=1]On Error Resume Next
[*=1]Set xlApp = GetObject(, "Excel.Application")
[*=1]If Err.Number <> 0 Then
[*=2]Err.Clear
[*=2]Set xlApp = CreateObject("Excel.Application")
[*=2]If Err.Number <> 0 Then
[*=3]GoTo Finish
[*=2]End If
[*=1]End If
[*=1]On Error GoTo Err_Handler
[*=1]Set xlBook = xlApp.Workbooks.Open(dSource, Notify:=False, ReadOnly:=True)
[*=1]Set xlSheet = xlBook.Sheets("MySheet")
[*=1]'Fill Word Tables
[*=1]Dim tbls, rng As Variant
[*=1]tbls = Array(tbla, tblb)
[*=1]rng = Array("Table1[#All]", "Table2[#All]")
[*=1]For i = LBound(tbls) To UBound(tbls)
[*=2]xlSheet.Activate
[*=2]xlSheet.Range(rng(i)).Copy
[*=2]tbls(i).Cell(3, 1).Range.Select
[*=2]Selection.PasteAsNestedTable
[*=1]Next
[*=1]
[*=1]Finish:
[*=1]Set xlBook = Nothing
[*=1]Set xlApp = Nothing
[*=1]Set fd = Nothing
[*=1]Exit Sub
[*=1]Err_Handler:
[*=1]MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
[*=1]Resume Finish
The code is fired from Word 2010 to locate and select an Excel Workbook (2010 .xlsm), Open the Workbook, Copy an Excel Table, and Paste As Nested Table into a table of the original Word document. For some reason, I am not always getting the "Paste As Nested Table" option in Word. The data seems to be on the clipboard, but it's not recognizing that I'm trying to paste within the table (error 4605). Any suggestions are much appreciated as I have searched and searched for similar threads.
I've posted most of the code below because it's probably some issue with my declarations, but the error is on line 44.
[*=1]Dim tbla, tblb As Table
[*=1]Set tbla = ActiveDocument.Tables(1)
[*=1]Set tblb = ActiveDocument.Tables(2)
[*=1]'Find The Workbook
[*=1]Dim xlApp As Excel.Application
[*=1]Dim xlBook As Excel.Workbook
[*=1]Dim xlSheet As Excel.Worksheet
[*=1]Dim dSource As String
[*=1]Dim fd As FileDialog
[*=1]
[*=1]Set fd = Application.FileDialog(msoFileDialogFilePicker)
[*=1]With fd
[*=1] .Title = "Select the Appendices Workbook."
[*=1] .Filters.Clear
[*=1] .Filters.Add "Excel Files", "*.xlsm"
[*=1] .AllowMultiSelect = False
[*=1] If .Show = -1 Then
[*=1] dSource = .SelectedItems(1)
[*=1] Else
[*=1] Exit Sub
[*=1] End If
[*=1]End With
[*=1]'Open The Workbook and define the sheet
[*=1]On Error Resume Next
[*=1]Set xlApp = GetObject(, "Excel.Application")
[*=1]If Err.Number <> 0 Then
[*=2]Err.Clear
[*=2]Set xlApp = CreateObject("Excel.Application")
[*=2]If Err.Number <> 0 Then
[*=3]GoTo Finish
[*=2]End If
[*=1]End If
[*=1]On Error GoTo Err_Handler
[*=1]Set xlBook = xlApp.Workbooks.Open(dSource, Notify:=False, ReadOnly:=True)
[*=1]Set xlSheet = xlBook.Sheets("MySheet")
[*=1]'Fill Word Tables
[*=1]Dim tbls, rng As Variant
[*=1]tbls = Array(tbla, tblb)
[*=1]rng = Array("Table1[#All]", "Table2[#All]")
[*=1]For i = LBound(tbls) To UBound(tbls)
[*=2]xlSheet.Activate
[*=2]xlSheet.Range(rng(i)).Copy
[*=2]tbls(i).Cell(3, 1).Range.Select
[*=2]Selection.PasteAsNestedTable
[*=1]Next
[*=1]
[*=1]Finish:
[*=1]Set xlBook = Nothing
[*=1]Set xlApp = Nothing
[*=1]Set fd = Nothing
[*=1]Exit Sub
[*=1]Err_Handler:
[*=1]MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
[*=1]Resume Finish