複数ファイルも可！Excelでチェックボックスを集計する方法

Sub フォルダ指定()
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        ActiveSheet.Range("B1").Value = .SelectedItems(1) ' B1にフォルダのパスを表示
    End With
 
End Sub
Sub アンケート集計()

    Dim folderPath As String
    Dim bookName As String
    Dim i As Long
    Dim r As Long
    
    folderPath = ActiveSheet.Range("B1").Value ' フォルダのパス
    bookName = Dir(folderPath & "\*.xls*") ' ブック名
    
    Application.ScreenUpdating = False
    
    ActiveSheet.Range("B6:B8") = 0 ' 集計結果を表示するB6:B8の値をリセット
    
    Do Until bookName = "" ' ブックがなくなるまで繰り返す
        Workbooks.Open (folderPath & "\" & bookName)
        r = 6 ' 集計結果を表示する最初のセルの行番号
        For i = 2 To 4 ' 集計したいファイルの2行目から4行目までをチェック
            If Worksheets(1).Cells(i, 3) = True Then ' 1番目のシートにチェックが付いていたら
                ThisWorkbook.ActiveSheet.Cells(r, 2) = ThisWorkbook.ActiveSheet.Cells(r, 2) + 1
            End If
            r = r + 1
        Next
        Workbooks(bookName).Close
        bookName = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "集計が完了しました。"

End Sub

Sub チェックボックスとセルをリンク()

    Dim cnt As Long
    Dim i As Long
    Dim cb As CheckBox
    
    cnt = Worksheets.Count ' シートの数
    
    For i = 2 To cnt ' 2番目以降のシートで繰り返す
        For Each cb In Worksheets(i).CheckBoxes
            cb.LinkedCell = cb.TopLeftCell.Offset(0, 1).Address 'チェックボックスから1つ右に移動した先のセルとリンク
        Next
    Next

    MsgBox "リンクの設定が完了しました。"

End Sub

Sub フォルダ指定()
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        ActiveSheet.Range("A1").Value = .SelectedItems(1) ' A1にフォルダのパスを表示
    End With
 
End Sub
Sub チェックボックスとセルをリンク()

    Dim folderPath As String
    Dim bookName As String
    Dim cb As CheckBox
    
    folderPath = ThisWorkbook.ActiveSheet.Range("A1").Value ' フォルダのパス
    bookName = Dir(folderPath & "\*.xls*") ' ブック名
    
    Application.ScreenUpdating = False
    
    Do Until bookName = "" ' ブックがなくなるまで繰り返す
        Workbooks.Open (folderPath & "\" & bookName)
        For Each cb In Worksheets(1).CheckBoxes ' 1番目のシートで繰り返す
            cb.LinkedCell = cb.TopLeftCell.Offset(0, 2).Address 'チェックボックスから2つ右に移動した先のセルとリンク
        Next
        Workbooks(bookName).Close SaveChanges:=True
        bookName = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "リンクの設定が完了しました。"

End Sub