| |
こんにちは。
簡単なサンプルですが研究してみてください。
'------------------------------------------------------------------------------
'同じフォルダに存在するブックのA1セルを書き換えるので注意して実行してください。
'------------------------------------------------------------------------------
Sub サンプル()
Dim ファイル名 As String
Dim 各シート As Worksheet
If ThisWorkbook.Path = "" Then
MsgBox "いったん保存してください。"
Exit Sub
End If
'1.マクロを書いたブックと同じフォルダの中から(ThisWorkbook.Path)
' 「*.xls」という名前のファイル名を取得する。
' (ここでは最初の１ファイル分の名前を受け取る)
ファイル名 = Dir(ThisWorkbook.Path & "\*.xls")
'2.1や8でファイル名が取得できなくなるまでDo〜Loopを繰り返す。
Do Until ファイル名 = ""
'3.取得したファイル名がマクロを書いたブックの名前(ThisWorkbook.Name)
' と違うならばIf〜End If内を処理する。
' (マクロを書いたブックの名前でも処理するとオープンするときに
' 「既に開いてます。2重に開くと…」とメッセージが出るのでそれを避けるため)
If ファイル名 <> ThisWorkbook.Name Then
'4.取得したファイル名のブックを開く。
Workbooks.Open ThisWorkbook.Path & "\" & ファイル名
'5.4で開いたブックの全ワークシートを一つ一つ処理する。
For Each 各シート In ActiveWorkbook.Worksheets
With 各シート
'6.A1セルが空っぽなら"A"と設定し、何か入っていれば後ろに"B"を付ける。
If .Range("A1").Value = "" Then
.Range("A1").Value = "A"
Else
.Range("A1").Value = .Range("A1").Value & "B"
End If
End With
Next
'6.4で開いたブックを保存する。
ActiveWorkbook.Save
'7.4で開いたブックを閉じる。
ActiveWorkbook.Close
End If
'8.次のファイル名を取得する。
'(1で指定した条件「*.xls」を満たすファイル名の２番目以降を取得)
ファイル名 = Dir()
Loop
MsgBox "終了しました。"
End Sub
|
|
へっぽこ
- 06/8/2(水) 15:05 -
