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
相关产品推荐
相关产品推荐

