大量のエクセル(ブック)の一括訂正のしごとでマクロを色々と調べたので記事にしておきます。
保護つきのシートだったので、一括で保護解除&保護が必要でした。
なので、ネットを漁り倒してマクロを組んでみみました。
Sub フォルダ内保護全て解除() Dim myFol As Object, myFile As Object, sh As Worksheet Dim openFilePath As String Const myPass As String = "1111" 'Set myFol = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0) 'If myFol Is Nothing Then Exit Sub Application.ScreenUpdating = False openFilePath = ThisWorkbook.Path & "\" '←変更 With CreateObject("Scripting.FileSystemObject") For Each myFile In .GetFolder(openFilePath).Files If .GetExtensionName(myFile.Path) = "xlsx" And openFilePath & ThisWorkbook.Name <> myFile.Path Then '←変更 With Application.Workbooks.Open(myFile.Path) For Each sh In .Worksheets sh.Unprotect Password:=myPass Next sh .Unprotect Password:=myPass .Save .Close False End With End If Next myFile End With MsgBox "終了しました" End Sub
これが保護解除
保護は以下。
Sub フォルダ内全て保護() Dim myFol As Object, myFile As Object, sh As Worksheet Dim openFilePath As String Const myPass As String = "1111" 'Set myFol = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0) 'If myFol Is Nothing Then Exit Sub Application.ScreenUpdating = False openFilePath = ThisWorkbook.Path & "\" '←変更 With CreateObject("Scripting.FileSystemObject") For Each myFile In .GetFolder(openFilePath).Files If .GetExtensionName(myFile.Path) = "xlsx" And openFilePath & ThisWorkbook.Name <> myFile.Path Then '←変更 With Application.Workbooks.Open(myFile.Path) For Each sh In .Worksheets sh.Protect Password:=myPass, DrawingObjects:=False, Contents:=True, Scenarios:=True, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _ AllowInsertingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True Next sh .Protect Password:=myPass, Structure:=True, Windows:=False .Save .Close False End With End If Next myFile End With MsgBox "終了しました" End Sub
参考になれば幸いです^^