在文件夹中的所有文件上运行宏（将链接的单元格分配给给定工作表上的所有复选框）

Question

我正在尝试重新分配大量工作簿中三个给定工作表上的复选框的所有链接单元格。

我已经在任何已开放的书上成功运作的宏：

Sub CheckBoxesControl()

On Error Resume Next

    Dim i As Long

    For i = 1 To 400
        Sheet4.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AA" & i
        Sheet21.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AB" & i
        Sheet22.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AC" & i

    Next i

End Sub

但是我希望在大量工作表中运行它，所以我尝试了以下内容：

Sub CheckBoxesControl()

On Error Resume Next
    Dim path As String
    Dim file As String
    Dim wkbk As Workbook
    Dim i As Long


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    path = "C:\file\path\"
    file = Dir(path)

    Do While Not file = ""
        Workbooks.Open (path & file)
        Set wkbk = ActiveWorkbook

    For i = 1 To 400
        Sheet4.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AA" & i
        Sheet21.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AB" & i
        Sheet22.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AC" & i

    Next i

    wkbk.Save
    wkbk.Close
    file = Dir
    Loop

End Sub

宏肯定会打开和关闭每个文件，并且运行时没有错误，但是没有达到预期的效果。

它只会更改我从静止运行宏的工作表的复选框（尽管显然是打开保存并关闭所有其他工具）。

我未能正确设置活动工作簿吗？

编辑1：建议修复（失败）

评论中建议的方法（证明不成功）：

Sub CheckBoxesControl()

On Error Resume Next
    Dim path As String
    Dim file As String
    Dim wkbk As Workbook
    Dim i As Long


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    path = "C:\file\path\"
    file = Dir(path)

    Do While Not file = ""

        Set wkbk = Workbooks.Open(path & file)
    For i = 1 To 400
        wkbk.Sheet4.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AA" & i
        wkbk.Sheet21.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AB" & i
        wkbk.Sheet22.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AC" & i
        If Err.Number <> 0 Then

        End If
    Next i

    wkbk.Save
    wkbk.Close
    file = Dir
    Loop

End Sub

编辑2：删除错误恢复

建议删除错误忽略说明了以下内容：当宏运行错误时：

运行时错误1004 找不到具有特定名称的项目。

调试此错误突出显示：

Sheet4.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AA" & i

我相信我意识到这个问题是什么：我正在使用“在1到400之间”循环以确保我抓住每个页面上的所有复选框，但是每个实例都没有复选框， （例如，checkbox1在所有页面上都不存在 - 特别是在第4页上不存在）

我现在记得这就是为什么我在第一个地方有错误恢复的原因...但是我需要“next”成为循环中的下一个“i”，而不是完整的下一个表达式。

Answer 1

更新4

对于那些在家里得分的人，问题是OP正在使用工作表CodeName，当从另一个电子表格中的宏引用它时，不能使用工作表 Dim ws As Worksheet Set ws = wkbk.Sheets("10. Prevention Finance") UpdateChkBoxes3 ws, "ChkBoxOutput!AA" Set ws = wkbk.Sheets("...") '#Modify the sheet name UpdateChkBoxes3 ws, "ChkBoxOutput!AB" Set ws = wkbk.Sheets("...") '#Modify the sheet name UpdateChkBoxes3 ws, "ChkBoxOutput!AC" 。

修改以接受工作表名称，并且可以调用其中任何一个：

Sub UpdateChkBoxes3(sht as Worksheet, lnkdCell as String)
Dim cb as CheckBox
Dim cbNum As Integer
With sht
    For Each cb In sht.CheckBoxes
        cbNum = Replace(cb.Name, "Check Box ", vbNullString)
        cb.LinkedCell = lnkdCell & cbNum
    Next
End With

更新3 （非ActiveX复选框）

.Name

我还修改了Update 2中的sub，以前粘贴在我的测试代码中，而不是需要sht / lnkdCell作为参数的正确子。

更新2

要考虑非索引复选框名称，但仍然遍历每个工作表中的所有复选框，请调用此子例程。我尝试从复选框的i属性中获取 numeric 值，这应该将它与单元格位置相关联，就像之前Index索引所做的那样，只有你会避免错误复选框不存在，因为我们没有循环Sub UpdateChkBoxes2(sht As Worksheet, lnkdCell As String) 'To address non-sequential/missing check box names not aligned with index Dim cb As OLEObject Dim cbNum As Integer With sht For Each cb In sht.OLEObjects If cb.progID Like "Forms.CheckBox*" Then cbNum = Replace(cb.Name, "Check Box ", vbNullString) cb.LinkedCell = lnkdCell & cbNum End If Next End With End Sub ，我们循环遍历形状本身。这应该适用于ActiveX复选框：

UpdateChkBoxes Sheet4, "ChkBoxOutput!AA"
UpdateChkBoxes Sheet21, "ChkBoxOutput!AB"
UpdateChkBoxes Sheet22, "ChkBoxOutput!AC"

'## Replaced the following error-prone code:
'For i = 1 To .CheckBoxes.Count
'    wkbk.Sheet4.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AA" & i
'    wkbk.Sheet21.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AB" & i
'    wkbk.Sheet22.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AC" & i
'    If Err.Number <> 0 Then
'
'    End If
'Next i

<强>更新

尝试类似这样的事情，它假设CheckBoxes根据它们的索引顺序命名，并且没有丢失的索引。

Sub UpdateChkBoxes(sht as Worksheet, lnkdCell as String)
With sht
    For i = 1 to .CheckBoxes.Count
    .CheckBoxes("Check Box " & i).LinkedCell = lnkdCell & i
    Next
End With
End Sub

然后，包括这个子程序：

FileSystemObject

原始回复

好的，我认为问题在于代码中没有任何内容实际上是在文件夹中的文件上进行迭代。您需要使用Microsoft Scripting Runtime来执行此操作。您可以启用对Object字典的引用，或者只是将这些变量声明为通用Scripting....而不是File

创建FSO，然后分配文件夹，并循环遍历此文件夹中的Option Explicit Sub LoopFiles() '## Requires reference to Microsoft Scripting Runtime Library Dim path As String Dim fso As New Scripting.FileSystemObject Dim folder As Scripting.folder Dim file As Scripting.file Dim wkbk As Workbook path = ThisWorkbook.path Set folder = fso.GetFolder(path) For Each file In folder.Files Select Case UCase(Right(file.Name, 4)) '## Make sure you're only working on XLS file types Case "XLSX", "XLSM", ".XLS" 'etc. ' Set wkbk = Workbooks.Open(file.Name) 'Now, send this WOrkbook Object to a subroutine CheckBoxesControl wkbk wkbk.Save wkbk.Close Case Else 'Do nothing End Select Next Set folder = Nothing Set fso = Nothing End Sub Sub CheckBoxesControl(wkbk As Workbook) Dim i As Long On Error Resume Next With wkbk For i = 1 To 400 .Sheet4.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AA" & i .Sheet21.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AB" & i .Sheet22.CheckBoxes("Check Box " & i).LinkedCell = "ChkBoxOutput!AC" & i Next i End With On Error GoTo 0 End Sub 个对象。打开文件，然后将其传递给子例程以执行复选框操作。

这样的事情：

{{1}}