大量のエクセル(ブック)の一括訂正のしごとでマクロを色々と調べたので記事にしておきます。
保護つきのシートだったので、一括で保護解除&保護が必要でした。
なので、ネットを漁り倒してマクロを組んでみみました。
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
参考になれば幸いです^^













