フォルダの中に複数のExcelファイル(ブック)が入っており、
それら全てのブック・シートの保護/解除を一括して行うマクロを現在使用しています。(後述)
<現在の利用状況>
◆フォルダの中に複数のExcelファイル(ブック)が入っている(雛形、シート構成は全て同じ)
◆全てのブックにパスワード付きでブック保護・シート保護をかけている→パスワードは共通(1111)
◆マクロ用ブックは上記の処理対象ブックとは別フォルダに入れている
(現在のVBAでは同一フォルダ内に入れた状態では作動しない)
◆マクロを実行する都度、任意のフォルダを選択する
<改善希望>
◆マクロ用ブックと処理対象のブックを同一フォルダに入れた状態で作動するようにしたい
(同一フォルダ内の自ブック以外のブックに対してブック・シートの保護/解除を一括処理したい)
VBA初心者なので構文をどう書き換えるかで行き詰っています。
ThisWorkbook.Path を使うというのはなんとなく分かりますが、
何パターンか試してエラーの繰り返しです…。
ご教示頂けます様お願いいたします。
-------------------------------------------------------------------------
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 = myFol.self.Path & "\"
With CreateObject("Scripting.FileSystemObject")
For Each myFile In .GetFolder(openFilePath).Files
If .GetExtensionName(myFile.Path) = "xls" 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
-------------------------------------------------------------------------
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 = myFol.self.Path & "\"
With CreateObject("Scripting.FileSystemObject")
For Each myFile In .GetFolder(openFilePath).Files
If .GetExtensionName(myFile.Path) = "xls" 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
-------------------------------------------------------------------------
No.1ベストアンサー
- 回答日時:
こんな感じでどうでしょうか?
'-------------------------------------------------
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) = "xls" 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) = "xls" 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
'-------------------------------------------------
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) フォルダ内の全ブックのシート名を変更したい 7 2022/09/22 21:34
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) vbaのエラー対応(実行時エラー7:メモリが不足しています) 4 2023/04/24 00:20
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) InputBoxでキャンセルボタンを押したらファイル自体を閉じたい 3 2022/07/23 17:52
- Visual Basic(VBA) VBA This Workbookモジュールを別ファイルにコピーする方法 1 2022/09/14 01:51
- Visual Basic(VBA) VBAが止まります。 2 2022/09/02 14:02
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/06 17:46
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
このQ&Aを見た人はこんなQ&Aも見ています
-
「環境が人を育てる」って本当?環境によって人格や生き方は本当に変わるのか
環境が人生に与える影響は実際どれほどのものなのか、専門家の田宮由美さんに伺った。
-
VBA フォルダ内の全ブック、さらに全シートの一括保護、解除(パスワードはなし)
Excel(エクセル)
-
EXCELで複数のシートを一度に「シートの保護」することはできますか?
Excel(エクセル)
-
エクセルで複数ファイルに同一のパスワードをまとめて設定したいです
Excel(エクセル)
-
-
4
エクセルの複数シートの保護を一括でする方法を教えてください(編集したいセルあり)
Excel(エクセル)
-
5
複数シートの保護・解除
Excel(エクセル)
-
6
複数ファイルへの一括パスワード入力&パスワード解除について
PowerPoint(パワーポイント)
-
7
フォルダ内のブック全部にパスワードを設定したい
Excel(エクセル)
-
8
Excelマクロ パスワードを入力して、全シート一括保護解除したい。
その他(Microsoft Office)
-
9
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
10
エクセル(excel)のパスワード解除について
その他(Microsoft Office)
-
11
フォルダ内の全てのファイルに貼り付けを行うマクロを作りたい
Visual Basic(VBA)
-
12
Excel 複数あるシートの保護解除(パスワード付き)
Excel(エクセル)
-
13
有無、要否、賛否、是非、可否、当否…これらの言葉について
その他(教育・科学・学問)
-
14
エクセル・複数のシートを一度に保護できませんか?
その他(ソフトウェア)
-
15
[Excel VBA] フォルダ内の複数のパスワード付ブックを全て読み取り専用で開くには?
Visual Basic(VBA)
-
16
フォルダ内の複数ファイルから、特定セルだけを抽出し、並び替えて集約したい
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel起動時に特定のワークシー...
-
VBAでブックを非表示で開いて処...
-
エクセルを共有するとPCによっ...
-
エクセルで「ディスクがいっぱ...
-
エクセルで参照しているデータ...
-
フォルダ内ブックの数式を全て...
-
Excelで複数ブックの同一セルに...
-
エクセルの関数 ENTERを押...
-
外部ブック参照が#REF!になって...
-
Excelで指定範囲のデータ...
-
【マクロ】【VBA】別ブックへの...
-
Excelでブックの共有を掛けると...
-
WorkBooksをオープンさせずにシ...
-
フォルダ内の複数ブック・シー...
-
VBAでブック保護非保護を判定す...
-
Excelファイルを開いても何も表...
-
ブックを開いた時にいつも同じ...
-
エクセルVBAでブック保護のUser...
-
フォルダ内の複数ファイルから...
-
VBAマクロで作成した新規ブック...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルを共有するとPCによっ...
-
VBAでブックを非表示で開いて処...
-
エクセルの関数 ENTERを押...
-
エクセルで参照しているデータ...
-
WorkBooksをオープンさせずにシ...
-
(マクロ)vlookupの元データを同...
-
Excelでブックの共有を掛けると...
-
Excel(2010)のフィルターが保...
-
エクセルで「ディスクがいっぱ...
-
Excelで複数ブックの同一セルに...
-
複数ファイルから特定シートの...
-
エクセルで別ブックをバックグ...
-
エクセルでウィンドウの枠固定...
-
Excelファイルをダブルクリック...
-
フォルダ内の複数ファイルから...
-
エクセルファイルを開かずにpdf...
-
外部ブック参照が#REF!になって...
-
エクセルで複数のシートを別フ...
-
エクセルシートの一部を送りたい
-
エクセルで50行ごとに区切った...
おすすめ情報