Template_M02_HeaderFooter

定番のヘッダー、フッターの瞬時に設定。リボンに登録して使用すると便利
（Microsoft365 64bit環境推奨）
　G-Tool1-A01 からのつづき
　６．【Alt】＋【F11】キーを押下し、VBE画面を出す。
　７．【挿入】タブから【標準モジュール】を選択し、標準モジュールを作成。
　８．下記ボックス内をコピーし、標準モジュールに貼り付ける。
　９．モジュール名を【M02_HeaderFooter】に変更する。
　モジュール名：M02_HeaderFooter
Option Explicit

'====================================================
'   全シートにヘッダーフッターを設定
'====================================================
Sub AllH_F_YuG()

    Dim i As Long
    Dim Motioncnt As Long

    On Error GoTo AllH_F_YuG_Err

    If Bln_Err = False Then
        ErrProsName = "AlIH_F_YuG"
        If IsCall = False Then
            Call StopUpdating
        End If
        '//プリンタとの接続を切断
        Application.PrintCommunication = False

        With ActiveWorkbook
            For i = 1 To .Sheets.Count
                Motioncnt = Int((10 / Sheets.Count) * i)
                DoEvents
                Application.StatusBar = " (" & i & " " & .Sheets.Count & ")" & _
                "を処理中・・・" & String(Motioncnt, "■") & _
               String(10 - Motioncnt, "□")
                If Worksheets(i).Visible = False Then
                    GoTo There
                End If
                Worksheets(i).Select
                With Worksheets(i).PageSetup
                    .LeftHeader = "&"" Yu Gothic, 標準""&10&D"
                    .CenterHeader = "&"" Yu Gothic, 太字""&12&A"
                    .RightHeader = "&""  Yu Gothic, 標準""P. &P/&N"
                    .LeftFooter = ""
                    .CenterFooter = "&"" Yu Gothic, 標準""&10&F"
                    .RightFooter = ""
                End With
                                        
There:
           Next i
           Application.StatusBar = ""
       End With
            
       '//プリンタを再接続
       Application.PrintCommunication = True
       '最小化
       If ActiveWorkbook.Name <> ThisWorkbook.Name Then
           Windows(ThisWorkbook.Name).WindowState = xlMinimized
       End If
    End If

AllH_F_YuG_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

AllH_F_YuG_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else
        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If

    Err.Clear          'エラー情報クリア
    GoTo AllH_F_YuG_Exit
End Sub
    
'====================================================
'    単シートにヘッダーフッターを設定
'====================================================
Sub SoloH_F_YuG()

    On Error GoTo SoloH_F_YuG_Err

    If Bln_Err = False Then
        ErrProsName = "SoloH_F_YuG"
        If IsCall = False Then
            Call StopUpdating
        End If

        '//プリンタとの接続を切断
        Application.PrintCommunication = False
        Application.StatusBar = ""
        With ActiveSheet.PageSetup
            .LeftHeader = "&"" Yu Gothic, 標準""&10&D"
            .CenterHeader = "&"" Yu Gothic, 太字""&12&A"
            .RightHeader = "&""  Yu Gothic, 標準""P. &P/&N"
            .LeftFooter = ""
            .CenterFooter = "&"" Yu Gothic, 標準""&10&F"
            .RightFooter = ""

        End With
        
        '//プリンタを再接続
        Application.PrintCommunication = True
        '最小化
        If ActiveWorkbook.Name <> ThisWorkbook.Name Then
            Windows(ThisWorkbook.Name).WindowState = xlMinimized
        End If
        
    End If

SoloH_F_YuG_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

SoloH_F_YuG_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else
        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If
    Err.Clear          'エラー情報クリア
    GoTo SoloH_F_YuG_Exit
End Sub
    
'====================================================
'   全シートにヘッダーフッターを設定
'====================================================
Sub AllH_F_MeiUI()

    Dim i As Long
    Dim Motioncnt As Long
    On Error GoTo AllH_F_MeiUI_Err
    If Bln_Err = False Then
        ErrProsName = "AlIH_F_YuG"
        If IsCall = False Then
            Call StopUpdating
        End If
        '//プリンタとの接続を切断
        Application.PrintCommunication = False
        With ActiveWorkbook
            For i = 1 To .Sheets.Count
                Motioncnt = Int((10 / Sheets.Count) * i)
                DoEvents
                Application.StatusBar = " (" & i & " " & .Sheets.Count & ")" & _
                "を処理中・・・" & String(Motioncnt, "■") & _
               String(10 - Motioncnt, "□")
                If Worksheets(i).Visible = False Then
                    GoTo There
                End If
                Worksheets(i).Select
                With Worksheets(i).PageSetup
                    .LeftHeader = "&"" Meiryo UI, 標準""&10&D"
                    .CenterHeader = "&"" Meiryo UI, 太字""&12&A"
                    .RightHeader = "&""  Meiryo UI, 標準""P. &P/&N"
                    .LeftFooter = ""
                    .CenterFooter = "&"" Meiryo UI, 標準""&10&F"
                    .RightFooter = ""
                End With
                                        
There:
            Next i
            Application.StatusBar = ""
        End With
            
        '//プリンタを再接続
        Application.PrintCommunication = True
        '最小化
        If ActiveWorkbook.Name <> ThisWorkbook.Name Then
            Windows(ThisWorkbook.Name).WindowState = xlMinimized
        End If
    End If

AllH_F_MeiUI_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

AllH_F_MeiUI_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else
        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If
    Err.Clear          'エラー情報クリア
    GoTo AllH_F_MeiUI_Exit
End Sub
    
'====================================================
'    単シートにヘッダーフッターを設定
'====================================================
Sub SoloH_F_MeiUI()

    On Error GoTo SoloH_F_MeiUI_Err

    If Bln_Err = False Then
        ErrProsName = "SoloH_F_MeiUI"
        If IsCall = False Then
            Call StopUpdating
        End If
        '//プリンタとの接続を切断
        Application.PrintCommunication = False
        Application.StatusBar = ""
        With ActiveSheet.PageSetup
            .LeftHeader = "&"" Meiryo UI, 標準""&10&D"
            .CenterHeader = "&"" Meiryo UI, 太字""&12&A"
            .RightHeader = "&""  Meiryo UI, 標準""P. &P/&N"
            .LeftFooter = ""
            .CenterFooter = "&"" Meiryo UI, 標準""&10&F"
            .RightFooter = ""
        End With
            
        '//プリンタを再接続
        Application.PrintCommunication = True
        '最小化
        If ActiveWorkbook.Name <> ThisWorkbook.Name Then
            Windows(ThisWorkbook.Name).WindowState = xlMinimized
        End If
    End If

SoloH_F_MeiUI_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

SoloH_F_MeiUI_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then

        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else
        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If
    Err.Clear          'エラー情報クリア
    GoTo SoloH_F_MeiUI_Exit
End Sub
    
'====================================================
'    単シートにヘッダーフッターを設定 縦 MeiryoUI
'====================================================
Sub SetMPortraite()

    On Error GoTo SetMPortraite_Err
    If Bln_Err = False Then
        ErrProsName = "SetMPortraite"
        If IsCall = False Then
            Call StopUpdating
        End If
        '//プリンタとの接続を切断
        Application.PrintCommunication = False
        
        Call showStatus("シート設定")
        With ActiveSheet.PageSetup
            .LeftHeader = "&"" Meiryo UI, 標準""&10&D"
            .CenterHeader = "&"" Meiryo UI, 太字""&12&A"
            .RightHeader = "&""  Meiryo UI, 標準""P. &P/&N"
            .LeftFooter = ""
            .CenterFooter = "&"" Meiryo UI, 標準""&10&F"
            .RightFooter = ""
            .Orientation = xlPortrait
        End With
        
        With ActiveSheet.Cells
            .Font.Name = "Meiryo UI"
            .Font.Size = 10
            .RowHeight = 18.75
        End With
        With ActiveSheet
            .Columns(1).ColumnWidth = 1.25
            .Columns(2).ColumnWidth = 58
            .Columns(2).WrapText = True
            .Columns(3).ColumnWidth = 1.25
        End With
        Call showStatus("")
        '//プリンタを再接続
        Application.PrintCommunication = True
        '最小化
        If ActiveWorkbook.Name <> ThisWorkbook.Name Then
            Windows(ThisWorkbook.Name).WindowState = xlMinimized
        End If
    End If

SetMPortraite_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

SetMPortraite_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else

        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If
    Err.Clear          'エラー情報クリア
    GoTo SetMPortraite_Exit
End Sub

'====================================================
'    単シートにヘッダーフッターを設定 縦 Yu Gothic
'====================================================
Sub SetYuPortraite()

    On Error GoTo SetYuPortraite_Err
    If Bln_Err = False Then
        ErrProsName = "SetYuPortraite"
        If IsCall = False Then
            Call StopUpdating
        End If
        '//プリンタとの接続を切断
        Application.PrintCommunication = False
        Call showStatus("シート設定")
        With ActiveSheet.PageSetup
            .LeftHeader = "&"" Yu Gothic, 標準""&10&D"
            .CenterHeader = "&"" Yu Gothic, 太字""&12&A"
            .RightHeader = "&""  Yu Gothic, 標準""P. &P/&N"
            .LeftFooter = ""
            .CenterFooter = "&"" Yu Gothic, 標準""&10&F"
            .RightFooter = ""
            .Orientation = xlPortrait
        End With
        With ActiveSheet.Cells
            .Font.Name = "Yu Gothic"
            .Font.Size = 10
            .RowHeight = 18.75
        End With
        With ActiveSheet
            .Columns(1).ColumnWidth = 1.25
            .Columns(2).ColumnWidth = 58
            .Columns(2).WrapText = True
            .Columns(3).ColumnWidth = 1.25
        End With
            
        '//プリンタを再接続
        Application.PrintCommunication = True
       '最小化
        If ActiveWorkbook.Name <> ThisWorkbook.Name Then
            Windows(ThisWorkbook.Name).WindowState = xlMinimized
        End If
    End If

SetYuPortraite_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

SetYuPortraite_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then

        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else
        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If
    Err.Clear          'エラー情報クリア
    GoTo SetYuPortraite_Exit

End Sub

'====================================================
'    単シートにヘッダーフッターを設定 縦 MeiryoUI
'====================================================
Sub SetMLandScape()

    On Error GoTo SetMLandScape_Err
    If Bln_Err = False Then
        ErrProsName = "SetMLandScape"
        If IsCall = False Then
            Call StopUpdating
        End If
        '//プリンタとの接続を切断
        Application.PrintCommunication = False
        Application.StatusBar = ""
        With ActiveSheet.PageSetup
            .LeftHeader = "&"" Meiryo UI, 標準""&10&D"
            .CenterHeader = "&"" Meiryo UI, 太字""&12&A"
            .RightHeader = "&""  Meiryo UI, 標準""P. &P/&N"
            .LeftFooter = ""
            .CenterFooter = "&"" Meiryo UI, 標準""&10&F"
            .RightFooter = ""
            .Orientation = xlLandscape
        End With
         
        With ActiveSheet.Cells
            .Font.Name = "Meiryo UI"
            .Font.Size = 10
            .RowHeight = 18.75
        End With
        With ActiveSheet
            .Columns(1).ColumnWidth = 1.25
            .Columns(2).ColumnWidth = 88
            .Columns(2).WrapText = True
            .Columns(3).ColumnWidth = 1.25
        End With
            
        '//プリンタを再接続
        Application.PrintCommunication = True
        '最小化
        If ActiveWorkbook.Name <> ThisWorkbook.Name Then
            Windows(ThisWorkbook.Name).WindowState = xlMinimized
        End If
    End If

SetMLandScape_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

SetMLandScape_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else
        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If
    Err.Clear          'エラー情報クリア
    GoTo SetMLandScape_Exit
End Sub

'====================================================
'    単シートにヘッダーフッターを設定 縦 MeiryoUI
'====================================================
Sub SetYuLandScape()

    On Error GoTo SetYuLandScape_Err
    If Bln_Err = False Then
        ErrProsName = "SetYuLandScape"
        If IsCall = False Then
            Call StopUpdating
        End If
        '//プリンタとの接続を切断
        Application.PrintCommunication = False
        Application.StatusBar = ""
        With ActiveSheet.PageSetup
            .LeftHeader = "&"" Yu Gothic, 標準""&10&D"
            .CenterHeader = "&"" Yu Gothic, 太字""&12&A"
            .RightHeader = "&""  Yu Gothic, 標準""P. &P/&N"
            .LeftFooter = ""
            .CenterFooter = "&"" Yu Gothic, 標準""&10&F"
            .RightFooter = ""
            .Orientation = xlLandscape
        End With
        
        With ActiveSheet.Cells
            .Font.Name = "Yu Gothic"
            .Font.Size = 10
            .RowHeight = 18.75
        End With
        With ActiveSheet
            .Columns(1).ColumnWidth = 1.25
            .Columns(2).ColumnWidth = 88
            .Columns(2).WrapText = True
            .Columns(3).ColumnWidth = 1.25
        End With
            
        '//プリンタを再接続
        Application.PrintCommunication = True
        '最小化
        If ActiveWorkbook.Name <> ThisWorkbook.Name Then
            Windows(ThisWorkbook.Name).WindowState = xlMinimized
        End If
    End If

SetYuLandScape_Exit:

    'エラーを無視
    On Error Resume Next
    Call ReSetObject
    Call Updating
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub

SetYuLandScape_Err:

    '【ESC】で止められた場合
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか?", vbYesNo) = vbNo Then
            Call exeBreak
            Resume
        End If

    'その他のエラー
    Else

        MsgBox "実行時エラー" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します｡", vbExclamation, ErrProsName
    End If
    Err.Clear          'エラー情報クリア
    Goto SetYuLandScape_Exit
End Sub