将Excel表格和图表复制并粘贴到带有特定书签的Word模板中：5941错误所选对象不存在

我继承了一个宏，它可以将Excel表格和图表复制并粘贴到带有特定书签的Word模板中。
原始宏运行。
我编辑了宏以在Excel中包含另一个工作表（Sheet4_new），然后通过添加带有Sheet4_new书签的页面来编辑Word模板。
现在宏粘贴了一些表格和图表（包括我添加的工作表中的图表），但表示其他图表不存在，但它们仍然在宏和Word模板中。
调试器突出显示此行：

myDoc.Bookmarks(ChartBookmarkArray(BookmarkCounter)).Range.Select

它只选择没有粘贴到Word模板中的图表和表格。
下面是继承的宏：

'Array for the various tabs of interest
    TabArray = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4_new", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9")`
  
'Arrays to switch between tables and charts of interest
    TableArray = Array("J15:L24", "A4:I14", "I16:K23", "B4:H15")
    ChartArray = Array("Chart 1", "Chart 2")
    
'List of Word Document Bookmarks (To Paste To)
    TableBookmarkArray = Array("Sheet1", "Sheet1Table", "Sheet2", "Sheet2Table", "Sheet3", "Sheet3Table", "Sheet4_new", "Sheet4_newTable", "Sheet5", "Sheet5Table", "Sheet6", "Sheet6Table", "Sheet7", "Sheet7Table", "BlankTable", "Sheet8", "Sheet9", "Sheet9Table")
    ChartBookmarkArray = Array("Sheet1Chart", "Sheet1Chart2", "Sheet2Chart", "Sheet2Chart2", "Sheet3Chart", "Sheet3Chart2", "Sheet4_newChart", "Sheet4_newChart2", "Sheet5Chart", "Sheet5Chart2", "BlankChart", "BlankChart", "BlankChart", "BlankChart", "Sheet8Chart", "Sheet8Chart2", "Sheet9Chart", "Sheet9Chart2")
 
  
'Variable for cycling through all the tables and charts in both arrays at the same time
    BookmarkCounter = 1

'Optimize Code
    Application.ScreenUpdating = False
    Application.EnableEvents = False

'Set Variable Equal To Destination Word Document
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    WordApp.Activate
    WordFilePath = "locationoncomputer"
    Set myDoc = WordApp.Documents.Open(WordFilePath & "nameofdoc.docx")
   

'Loop Through and Copy/Paste Multiple Excel Tables and Charts
    For x = LBound(TabArray) To UBound(TabArray)`
    
        ActiveWorkbook.Worksheets(TabArray(x)).Activate

        If x = 2 Then
            RangeSwitcher = 1
            IsThereSomething = ThisWorkbook.Worksheets(TabArray(x)).Range("K23").Value
                'ElseIf x = 4 Or x = 5 Then
            'RangeSwitcher = 5
            'IsThereSomething = ThisWorkbook.Worksheets(TabArray(x)).Range("J19").Value
        Else
            RangeSwitcher = 3
            IsThereSomething = ThisWorkbook.Worksheets(TabArray(x)).Range("J20").Value
        End If

    'Switch between the two charts and tables in any tab
        For y = 1 To 2
        
            If x <> 7 Then
            'Copy Table Range from Excel
                Set tbl = ThisWorkbook.Worksheets(TabArray(x)).Range(TableArray(RangeSwitcher))
                tbl.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5) 
                myDoc.Bookmarks(TableBookmarkArray(BookmarkCounter)).Range.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
        
            ElseIf y = 2 Then
                
                Set tbl = ThisWorkbook.Worksheets(TabArray(x)).Range(TableArray(RangeSwitcher))
                tbl.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                myDoc.Bookmarks(TableBookmarkArray(BookmarkCounter)).Range.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                    
            End If
                    
       
            For Each iShape In WordApp.ActiveDocument.InlineShapes
                If iShape.AlternativeText = "" Then
                Set pShape = iShape
                pShape.AlternativeText = "table"
                Exit For
                End If
            Next
            
        
            If x <> 5 And x <> 6 Then
            'Check if there are no counts & costs in the current table selection
                If IsThereSomething = 0 Then
                'If there's no counts or costs for this county, then we put in some replacement text instead of a chart
                    myDoc.Bookmarks(ChartBookmarkArray(BookmarkCounter)).Range.Select
                    myDoc.Bookmarks(ChartBookmarkArray(BookmarkCounter)).Range.Text = NothingReplacementTextArray(BookmarkCounter)
                Else
                'Otherwise, copy the corresponding chart
                    With ActiveSheet.ChartObjects(ChartArray(y))
                        .Activate
                        .Select
                    End With
                    ActiveChart.ChartArea.Copy
    
                'Used this at first but it's not that nice looking for charts when they're pasted in
                    'myDoc.Bookmarks(ChartBookmarkArray(BookmarkCounter)).Range.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
                    'Placement:=wdInLine, DisplayAsIcon:=False
    
                    myDoc.Bookmarks(ChartBookmarkArray(BookmarkCounter)).Range.Select
                    myDoc.Bookmarks(ChartBookmarkArray(BookmarkCounter)).Range.Text = ""
                    WordApp.ActiveDocument.Application.Selection.PasteSpecial Link:=False, DataType:=14, _
                        Placement:=wdInLine, DisplayAsIcon:=False
                
                    For Each iShape In WordApp.ActiveDocument.InlineShapes
                        If iShape.AlternativeText = "" Then
                        Set pShape = iShape
                        pShape.ScaleHeight = 65
                        pShape.ScaleWidth = 65
                        pShape.AlternativeText = "chart"
                        Exit For
                        End If
                    Next
                End If
            End If

      
            ThisWorkbook.Worksheets(TabArray(x)).Range("C2").Select

        'Move to the next bookmark in the list
            BookmarkCounter = BookmarkCounter + 1
        'Switch table range to second table on tab
            RangeSwitcher = RangeSwitcher + 1

        Next y
    Next x

尝试删除和重新添加书签，得到相同的错误。

这就是问题所在：

myDoc.Bookmarks(ChartBookmarkArray(BookmarkCounter)).Range.Text = ""

设置书签区域的文本将删除书签。
举例说明：

Dim bm As Bookmark
    
Set bm = ActiveDocument.Bookmarks("Test")
bm.Range.Text = ""
Set bm = ActiveDocument.Bookmarks("Test") 'Error: The requested member of the collection does not exist

这里有一个解决方案：

Sub Tester()
    
    Dim bm As Bookmark
    
    Set bm = ActiveDocument.Bookmarks("Test")
    
    'bm.Range.Text = ""     'this will delete the bookmark
    SetBookmarkText bm, ""  '...this will not (effectively)
End Sub

'Set a bookmark's Text; recreate it after it's deleted
Sub SetBookmarkText(bm As Bookmark, txt As String)
    Dim nm As String, rng As Range
    nm = bm.Name
    Set rng = bm.Range
    With rng
        .Text = txt
        .Bookmarks.Add Name:=nm 're-add the bookmark
    End With
End Sub

将Excel表格和图表复制并粘贴到带有特定书签的Word模板中：5941错误所选对象不存在

1条答案

相关问题

热门标签

最新问答