hate_aaa3の技術備忘録メモ

自分用メモ(IT系)をストックしていきます。

特定フォルダ直下に含まれるxls,xlsxファイルのすべてのシートに対しすべてに同じ処理を行う【Excel VBA】

44行目から58行目は、任意の処理に置き換えれば流用可能。

'特定フォルダ直下に含まれるxls,xlsxファイルのすべてのシートに対しすべてに同じ処理を行う
Sub Excel_book_change()

Dim FolderName As String  '文字列を入れる変数として「FolderName」を使う
Dim index As Integer  '数字を入れる変数として「index」を使う
Dim FileName As String  '文字列を入れる変数として「FileName」を使う
Dim i As Integer


Application.ScreenUpdating = False

    'FileDialogオブジェクトのインスタンス取得:フォルダ選択ダイログ
    With Application.FileDialog(msoFileDialogFolderPicker)
         
        
        .Title = "フォルダを選択してください"  'ダイアログのタイトルを設定             
        .InitialFileName = ThisWorkbook.Path 'ダイアログの初期パスを設定

        If Not .Show Then Exit Sub             'ダイアログを表示(キャンセル:処理抜け)
         
        FolderName = .SelectedItems(1)        '選択したフォルダのフルパスを変数格納

         
    End With
    
    
'実行可否判定
If MsgBox("選択されたフォルダは、" & FolderName & "です。 実行しますか?", vbDefaultButton2 + vbYesNo) = vbNo Then
    MsgBox ("処理を終了します。")
    Application.ScreenUpdating = True
    Exit Sub
End If


'選択されたフォルダ直下のるxls,xlsxファイルのすべてのシートに対しすべてに同じ処理を行う
FileName = Dir(FolderName & "\*xls*")  ' フォルダの中に含まれるファイルを取り出す
Do While FileName <> ""  ' ファイルがなくなるまで繰り返す
  Workbooks.Open FolderName & "\" & FileName 'ファイルを開く
        
        
        
     ' ForからNextまでに処理を記載
     For i = 1 To Worksheets.Count

        '全シートA1選択
        Worksheets(i).Activate
        Worksheets(i).Cells(1, 1).Select

        '印刷設定
        With Worksheets(i)
    
            .PageSetup.Orientation = xlLandscape '印刷の向きを「横」
            .PageSetup.PaperSize = xlPaperA4     '指定する用紙A4
            .PageSetup.CenterFooter = "- " & "&P" & " -"  'フッターにページ番号を表示
            .PageSetup.RightHeader = "&F" '右ヘッダー:現在の日付・時刻
    
        End With


    Next
        
        Worksheets(1).Activate
        Workbooks(Workbooks.Count).Save
        Workbooks(Workbooks.Count).Close
        
        
        FileName = Dir() '
Loop

 
 Application.ScreenUpdating = True
 
 
End Sub

test