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

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 页上不存在)

我现在记得这就是为什么我首先在​​那里有 On error resume next 的原因......但我需要“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"

更新 3 (非 ActiveX 复选框)

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

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

更新 2

要考虑非索引复选框名称，但仍循环遍历每个工作表中的所有复选框，请调用此子例程。我试图从复选框的 .Name 中获取数值属性，这应该与单元格位置相关，就像您的 i索引以前做过，只有你会避免复选框不存在的错误，因为我们没有循环 Index ，我们正在循环形状本身。这应该适用于 ActiveX 复选框:

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

更新

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

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

然后，包括这个子例程:

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....
创建一个 FSO，然后分配一个文件夹，然后遍历 File此文件夹中的对象。打开该文件，然后将其传递给子例程以执行您的复选框操作。

像这样的东西:

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