VBA 关闭除以前打开的工作簿

Question

我一直在想办法解决这个问题。所以我在一个 Excel 工作簿中有代码，可以从 Word 文档中的图表打开和修改嵌入的 Sourcedata 工作簿。

我想要做的是从 word 文档中的图表中关闭所有嵌入的工作簿，但使用 Application.Workbooks 集合和“For Each workbook”循环。当我尝试使用此循环时，它会关闭所有工作簿，甚至是在运行打开嵌入式工作簿的代码之前打开的工作簿。所以我编写了只像这样关闭嵌入式工作簿的代码，但这需要太长时间：

 Dim K As InlineShape
    Dim chrt1 As Word.Chart
    Dim xWB As Workbook
     

 
For Each K In aktDocument.InlineShapes
           If K.HasChart Then
              Set chrt1 = K.Chart
              chrt1.ChartData.Activate
              Set xWB = chrt1.ChartData.Workbook
              xWB.Activate
             xWB.Close
           End If
    Next

有没有办法使用 For each workbook 循环来关闭所有嵌入的工作簿，而不是在运行代码以及 ThisWorkbook（包含代码）之前关闭所有其他以前打开的工作簿。已打开的工作簿数量因运行代码的人而异。

Answer 1

你所做的很有意义。这是一个使用For...Next 而不是For...Each 的版本。我还使用嵌套的With 根据需要自动创建和销毁对象。删除Activate 会加快速度。

Public Sub CloseInlineExcelBooks()

    Dim thisShape As Long

    With ActiveDocument
        For thisShape = 1 To .InlineShapes.Count
            With .InlineShapes(thisShape)
                If .HasChart Then
                    With .Chart.ChartData.Workbook
                        .Close
                    End With
                End If
            End With
        Next thisShape
    End With
End Sub

Answer 2

请使用下一个函数返回嵌入的工作簿名称。然后你应该在打开的工作簿之间迭代并关闭它们：

Function embededWB() As Variant
    Dim k As InlineShape, arr, k As Long
    
    ReDim arr(100)
    For Each k In aktDocument.InlineShapes
           If k.HasChart Then
              arr(k) = k.Chart.ChartData.Workbook.Name: k = k + 1
           End If
    Next
    ReDim Preserve arr(k - 1)
    embededWB = arr
End Function

我会建议下一个使用它的方法：

 Sub testClosingWorkbooks()
  'part to create the open Excel object, let us say objExcel
  Dim objExcel As Object
  Set objExcel = GetObject(, "Excel.Application") 'open Excel session
  'if the Excel object is already referenced/created, you should use it...
  
  Dim arr, El, wb As Excel.Workbook
  For Each El In arr
     For Each wb In objExcel.Workbooks
        If wb.Name = El Then wb.Close
     Next wb
  Next  
End Sub