You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Excel宏仅生效于首个工作簿,如何修改为作用于所有工作簿?

修改宏以作用于所有打开的工作簿

原宏仅作用于活动工作簿的核心原因是代码始终绑定ActiveWorkbook对象,未遍历所有打开的工作簿。以下是修改后的完整代码及关键调整说明:

Sub Add_Connection_All_Tables_All_Workbooks()
'Creates Connection Only Queries to all tables in ALL OPEN workbooks.

Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim sName As String
Dim sFormula As String
Dim wq As WorkbookQuery
Dim bExists As Boolean
Dim vbAnswer As VbMsgBoxResult
Dim vbDataModel As VbMsgBoxResult
Dim totalConnections As Long
Dim wbConnections As Long
Dim dStart As Double
Dim dTime As Double

  'Prompt for running macro on all open workbooks
  vbAnswer = MsgBox("Do you want to run the macro to create connections for all Tables in ALL OPEN workbooks?", vbYesNo, "Power Query Connect All Tables Macro")

  If vbAnswer = vbYes Then
  
    'Prompt for Data Model option
    vbDataModel = MsgBox("Do you want to add the data to the Data Model for all tables?", vbYesNo + vbDefaultButton2, "Power Query Connect All Tables Macro")

    dStart = Timer
    totalConnections = 0
    
    'Loop through every open workbook
    For Each wb In Application.Workbooks
      wbConnections = 0
      
      'Skip Personal Macro Workbook (optional, remove if you want to include it)
      If wb.Name <> "PERSONAL.XLSB" Then
      
        'Loop sheets and tables in current workbook
        For Each ws In wb.Worksheets
          For Each lo In ws.ListObjects
            
            sName = lo.Name
            sFormula = "Excel.CurrentWorkbook(){[Name=""" & sName & """]}[Content]"
            
            'Check if query already exists in current workbook
            bExists = False
            For Each wq In wb.Queries
              If InStr(1, wq.Formula, sFormula) > 0 Then
                bExists = True
                Exit For 'Exit early to save processing time
              End If
            Next wq
            
            'Add query and connections if not existing
            If bExists = False Then
            
              wb.Queries.Add Name:=sName, _
                             Formula:="let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""" & sName & """]}[Content]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    Source"
              wb.Connections.Add2 Name:="Query - " & sName, _
                                  Description:="Connection to the '" & sName & "' query in the workbook.", _
                                  ConnectionString:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sName & ";Extended Properties=""""", _
                                  CommandText:="SELECT * FROM [" & sName & "]", _
                                  lCmdtype:=2, _
                                  CreateModelConnection:=False, _
                                  ImportRelationships:=False
                                  
              If vbDataModel = vbYes Then
                wb.Connections.Add2 Name:="Query - " & sName, _
                                    Description:="Connection to the '" & sName & "' query in the workbook.", _
                                    ConnectionString:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sName & ";Extended Properties=", _
                                    CommandText:="" & sName & "", _
                                    lCmdtype:=6, _
                                    CreateModelConnection:=True, _
                                    ImportRelationships:=False
              End If
              
              wbConnections = wbConnections + 1
              totalConnections = totalConnections + 1
              
            End If
          Next lo
        Next ws
        
        'Show per-workbook result (optional, comment out if not needed)
        If wbConnections > 0 Then
          MsgBox wbConnections & " connections created in: " & wb.Name, vbOKOnly, "Workbook Processed"
        Else
          MsgBox "No new connections required for: " & wb.Name, vbOKOnly, "Workbook Processed"
        End If
        
      End If
    Next wb
  
  'Calculate and show total run time
  dTime = Timer - dStart
  MsgBox totalConnections & " total connections created in " & Format(dTime, "0.0") & " seconds.", vbOKOnly, "All Workbooks Processed"
  
  End If

End Sub

核心修改点:

  • 新增For Each wb In Application.Workbooks循环,遍历所有打开的工作簿
  • 将所有原ActiveWorkbook的引用替换为循环变量wb,确保操作针对当前遍历的工作簿
  • 调整提示框文案,明确告知操作范围是所有打开的工作簿
  • 添加totalConnections和wbConnections变量,分别统计总创建数和单个工作簿的创建数
  • 增加可选逻辑:跳过个人宏工作簿(PERSONAL.XLSB),避免对宏文件执行不必要操作
  • 新增单个工作簿处理完成后的提示(可选,可根据需求注释或删除)
  • 优化查询存在性检查:找到匹配后立即退出循环,减少不必要的遍历

内容的提问来源于stack exchange,提问作者Daisy Hernandez

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.14 19:55:59