|
VBAは全くの初心者です。OSはWindowsXP、Excel2000を使用しています。
よろしくお願いいたします。
サーバーに受注票が(注文1件につき1sheet、各20sheetずつあるファイルが5つ)保管されています。
書式等はすべて同じで、それぞれA10:B12、B10:B12、C10:I12に受注番号などのデータが入力されています。
今回は、その受注番号などの一覧表を作成しようと思ってVBAに初挑戦することになりました。
全くのド素人のため、丁度「これは良いかもしれない!」と思う記述をネット内で見つけることができ、もしルール違反だったら申し訳ないのですが、使わせていただくことにしました。範囲名などを変えて実行してみたところ、もともと1sheetのみのファイルに対しての記述であったため、book内での繰り返し処理がなく、うまくいきません。
四苦八苦しながら、やっとFor Intcount To Thisworkbook sheet.count(?) というループ処理がシートの数だけループするということを知りました。
ただそのステートメントをどこに挿入すれば良いのかが、あれこれやってみたのですがどうしても分かりません。
どうか教えてください!!
Sub test02()
'Microsoft Shell Controls And Automation に参照設定をしておくこと。
Dim strPath As String
Dim objShell As New Shell32.Shell
Dim objFolder As Shell32.Folder
Dim strFileName As String
Dim lngRow As Long
Dim wbkSource As Workbook
'フォルダ選択ダイアログ
Set objFolder = objShell.BrowseForFolder(0, "フォルダを選択してください。", 0)
' 選択内容を取得
If Not objFolder Is Nothing Then
strPath = objFolder.Items.Item.Path
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strFileName = Dir(strPath & "*.xls", vbNormal)
If strFileName <> "" Then
Application.ScreenUpdating = False '画面表示抑止
With ThisWorkbook.ActiveSheet
.Range("A1:C1").EntireColumn.ClearContents
lngRow = 0
Do While strFileName <> ""
lngRow = lngRow + 1
Set wbkSource = Workbooks.Open(strPath & strFileName)
.Cells(lngRow, "A").Value = wbkSource.ActiveSheet.Range("A10:B12").Value
.Cells(lngRow, "B").Value = wbkSource.ActiveSheet.Range("B10:B12").Value
.Cells(lngRow, "C").Value = wbkSource.ActiveSheet.Range("C10:I12").Value
wbkSource.Close False
strFileName = Dir()
Loop
End With
Application.ScreenUpdating = True '画面表示抑止の解除
End If
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
です。
出来れば、フォルダを選択せず、パス名を入れたいのですが出来ず、サーバー内のフォルダだからなのかそれも分からずじまいです。
・シートの数だけループする
・サーバー内のフォルダを指定する
方法を、教えてください。よろしくお願いいたします。
|
|