Excel VBAを用いた一括ファイル処理方法

質問

Excelコマンドボタンを用いて、特定のフォルダ内に格納されたExcelファイルの一括処理をしたいのですが、おもうようにできません。
一括処理内容は、A列以外入力できないようにロックさせる処理になります。
（可能であればPW設定もつけたい。）

いろいろサンプルコードやマクロの記録で繋げてみたのですが、おもうようにできません。

どうすればよいのか教えて頂きたく、どうぞよろしくお願いいたします。

＜コード＞

Private Sub CommandButton1_Click()

Dim fileNmCol As Collection 'ファイル名格納コレクション
Dim folderPath As String 'フォルダのフルパス

'作業用
Dim tempFileNm As Variant
Dim fullPath As String

Set fileNmCol = New Collection

'フォルダパス
folderPath = "C:\TEST\"

'Dirにより、ファイル名を取得（xlsファイルのみ）
'フォルダ配下にあるファイル名を順次fileNmに格納する。
tempFileNm = Dir(folderPath + "*.xls", vbNormal)

'ファイル名をfileNmColに追加する
Do While tempFileNm <> ""
fileNmCol.Add (tempFileNm)
tempFileNm = Dir()
Loop

'ファイルの数だけ繰り返し
For Each tempFileNm In fileNmCol

'ファイルのフルパスを設定指定して、Excelブックを開く
fullPath = folderPath + tempFileNm
Workbooks.Open fullPath

Cells.Select
Selection.Locked = False
Selection.FormulaHidden = False
Columns("I:I").Select
Range(Selection, Selection.End(xlToLeft)).Select
Columns("C:I").Select
Range("I1").Activate
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Range("A1").Select
ActiveWorkbook.Save

'ファイルを閉じる（アラートを無効にする）
Application.DisplayAlerts = False
Workbooks(tempFileNm).Close
Application.DisplayAlerts = True

Next

End Sub

回答No.2

keithin · ベストアンサー

あれあれ、ごめんなさい、誤記がありましたね。

sub macro1()
　dim myPath as string
　dim myFile as string

　mypath = "c:\test\"
　myfile = dir(mypath & "*.xls*")

　do until myfile = ""
’ブックを開く
　workbooks.open mypath & myfile

’ロックを設定し，保護する
　cells.locked = true
　range("A:A").locked = false
　activesheet.protect password:= "abc", allowfiltering:=true

’保存して閉じる
　activeworkbook.close savechanges:=true

’次のブック
　myfile = dir()
　loop
end sub

失礼しました。

＞オートフィルタリングは可能にしたい

上述のようにして可能です。
念のため補足しておきますが、シートを保護する「前に」オートフィルタを設置しておいて、ブックを保存しておかないと意味が無い事はご存知ですね。

＞保護の解除
unprotectするだけです。ＶＢＡのヘルプも参考にしてください。
所定のフォルダのブックを逐一開いて設定する等は、全く同じマクロなのは判りますね。

お礼

わざわざご指導いただきありがとうございました。

少し前にNo1のお礼欄に記載させていただきましたが、No1で回答いただきましたコードを参考に、いろいろ調べたら、解消しました。

このたびは、本当にありがとうございました。

回答No.1

keithin

まず。
＞Excelコマンドボタンを用いて

失敗の元なので，今回はこれをやめます。（後述参考参照）
代わりに次のように準備します

準備：
白紙ブックを用意する
ＡＬＴ＋Ｆ１１を押してＶＢＥ画面を出す
挿入メニューから標準モジュールを挿入する
下記のマクロをコピー貼り付ける
終了してエクセルに戻る
オートシェイプの図形等を用いてマクロボタンを設置する
右クリックしてマクロの登録からマクロを登録する

実際のマクロとしては，対象ブックの開いたシートを対象に実施します（若しくは，各対象ブックには１枚しかシートが無い）

sub macro1()
　dim myPath as string
　dim myFile as string

　mypath = "c:\test\"
　myfile = dir(mypath & "*.xls*")

　do until myfile = ""
’ブックを開く
　workbooks.open mypath & myfile

’ロックを設定し，保護する
　cells.locked = true
　range("A:A").locked = false
　activesheet.protect password = "abc"

’保存して閉じる
　activeworkbook.close savechanges:=true

’次のブック
　myfile = dir()
　loop
end sub

参考：
失敗する理由は下記参照してみてください
http://okwave.jp/qa/q7692730.html

お礼

たびたびすいません。

回答いただきましたコードを参考に、いろいろ調べたら、解消しました。

このたびはありがとうございました。

--------------------------------------------------------------------
Sub セルロック一括処理()

Dim myPath As String
Dim myFile As String

myPath = "C:\TEST\"
myFile = Dir(myPath & "*.xls*")

Do Until myFile = ""

'ブックを開く
Workbooks.Open myPath & myFile

'現在のワークシートに A1セルから始まるオートフィルタを設定・解除
'オートフィルタが設定済みでは解除し、無ければ設定する。

With ActiveSheet.Range("A1")
If Not .AutoFilter Then .AutoFilter
End With

'ロックを設定し，保護する
Cells.Locked = True
Range("A:A").Locked = False
ActiveSheet.Protect Password:="abc", _
AllowFiltering:=True

'保存して閉じる
ActiveWorkbook.Close savechanges:=True

'次のブック
myFile = Dir()

Loop

End Sub

--------------------------------------------------------------------

Sub セルロック解除一括処理()

Dim myPath As String
Dim myFile As String

myPath = "C:\TEST\"
myFile = Dir(myPath & "*.xls*")

Do Until myFile = ""

'ブックを開く
Workbooks.Open myPath & myFile

'ロックを解除
ActiveSheet.Unprotect Password:="abc"

'保存して閉じる
ActiveWorkbook.Close savechanges:=True

'次のブック
myFile = Dir()

Loop

End Sub

--------------------------------------------------------------------

補足

ご教授頂きありがとうございます。

上記、コードで試したところ、一括ロック処理はできましたが

ロックの解除（シートの保護の解除）ができませんでした。（PWが違うと表示される。）

原因は何かわかるでしょうか？？

また、シートのロック設定で、オートフィルタリングは可能にしたいのですが、何か方法はないでしょうか？

また、指定ファイル内のセルロック解除の一括処理は可能でしょうか？
（上記コードで、セルロック（PWあり）をしたものを、今度は一括解除したい。）

いくつも問い合わせしてしまい、大変恐縮ですが、どうぞよろしくお願いいたします。