Excel VBAで指定したエクセルファイルの印刷設定を変更してみた

エクセルファイルで設計書を作成した場合などに、ヘッダーやフッターを設定したり、印刷プレビューの設定を変更したりすることが多い。

今回は、Excel VBAを利用して、ヘッダーやフッターを設定したり、印刷プレビューを設定したりしてみたので、そのサンプルプログラムを共有する。

前提条件

下記記事の実装が完了していること。

Excel VBAで指定したエクセルファイルを編集する処理を実装してみたExcel VBAでは、他のエクセルファイルを開き、編集し、保存するような処理を実装することができる。今回は、その処理を行うサンプルプロ...

サンプルプログラムの作成

ファイル「EditExcel.xlsm」をコピーし、「EditExcelFormat.xlsm」とリネームする。その後、VBAのソースコードを以下のように変更する。

Option Explicit  '変数の宣言を必須にする

'-----------------------------------------------------------
' 機能: 指定したエクセルファイルを編集する
' 引数: なし
' 返り値: なし
'-----------------------------------------------------------
Sub editExcel()
    'マクロ実行中の画面表示を更新しないようにする
    Application.ScreenUpdating = False
    
    'ファイルパスを取得する
    Dim filePath As String
    filePath = Range("C5").Value
    
    'ファイルパスが未指定の場合は、処理を終了する
    If filePath = "" Then
        MsgBox "ファイルパスが指定されていません、処理を終了します"
        Exit Sub
    End If
    
    'ファイル名を取得する
    Dim fileName As String
    fileName = Dir(filePath)
   
    '指定したエクセルファイルを開く
    'ファイルが開けなかった場合は、処理を終了する
    If openExcel(filePath, fileName) = False Then
        Exit Sub
    End If
   
    '指定したエクセルファイルのヘッダー・フッター・印刷プレビューを編集する
    Call setHeaderFooter(fileName)
    Call setPrintPreview(fileName)
    
    '指定したエクセルファイルを保存して閉じる
    Workbooks(fileName).Save
    Workbooks(fileName).Close
    
    'マクロ実行中の画面表示を元に戻す
    Application.ScreenUpdating = True
    
    '完了メッセージを表示
    MsgBox filePath + "の編集が完了しました"
End Sub

'-----------------------------------------------------------
' 機能: 引数で指定したエクセルファイルを開く
' 引数: filePath/ファイルパス、fileName/ファイル名
' 返り値: openExcel/ファイルを開けたかどうか
'-----------------------------------------------------------
Function openExcel(filePath As String, fileName As String)
    'ファイルが存在しなければ、処理を終了する
    If fileName = "" Then
        MsgBox filePath + "が存在しません、処理を終了します"
        openExcel = False
        Exit Function
    End If
    
    'ファイルがエクセルファイルでなければ、処理を終了する
    With CreateObject("Scripting.FileSystemObject")
        If .GetFile(filePath).Type <> "Microsoft Excel ワークシート" Then
            MsgBox fileName + "はエクセルファイルではありません、処理を終了します"
            openExcel = False
            Exit Function
        End If
    End With
   
    '指定したファイルが開いていれば、処理を終了する
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name = fileName Then
            MsgBox fileName + "が既に開いています、処理を終了します"
            openExcel = False
            Exit Function
        End If
    Next wb
    
    '指定したファイルを開く
    Workbooks.Open filePath
    openExcel = True
End Function

'-------------------------------------------------------------------
' 機能: 引数で指定したエクセルファイルのヘッダーとフッターを編集する
' 引数: fileName/ファイル名
' 返り値: なし
'-------------------------------------------------------------------
Sub setHeaderFooter(fileName As String)
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        With Workbooks(fileName).Sheets(ws.Name).PageSetup
           .CenterHeader = fileName & "／" & ws.Name  'ヘッダーの中央はファイル名／シート名
           .CenterFooter = "&P/&N"                'フッターの中央は現在のページ数/総ページ数
           .RightFooter = "@2020 purin-it.com"        'フッターの右側にCopyright句
        End With
    Next ws
End Sub

'---------------------------------------------------------------
' 機能: 引数で指定したエクセルファイルの印刷プレビューを編集する
' 引数: fileName/ファイル名
' 返り値: なし
'---------------------------------------------------------------
Sub setPrintPreview(fileName As String)
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        With Workbooks(fileName).Sheets(ws.Name).PageSetup
             .Orientation = xlLandscape   '印刷の向きは横
             .Zoom = False                '拡大率・縮小率は設定しない
             .FitToPagesTall = False      '縦方向は指定しない
             .FitToPagesWide = 1          '横方向は1シートにする
        End With
    Next ws
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

Option Explicit '変数の宣言を必須にする

'-----------------------------------------------------------

' 機能: 指定したエクセルファイルを編集する

' 引数: なし

' 返り値: なし

'-----------------------------------------------------------

Sub editExcel()

'マクロ実行中の画面表示を更新しないようにする

Application.ScreenUpdating = False

'ファイルパスを取得する

Dim filePath As String

filePath = Range("C5").Value

'ファイルパスが未指定の場合は、処理を終了する

If filePath = "" Then

MsgBox "ファイルパスが指定されていません、処理を終了します"

Exit Sub

End If

'ファイル名を取得する

Dim fileName As String

fileName = Dir(filePath)

'指定したエクセルファイルを開く

'ファイルが開けなかった場合は、処理を終了する

If openExcel(filePath, fileName) = False Then

Exit Sub

End If

'指定したエクセルファイルのヘッダー・フッター・印刷プレビューを編集する

Call setHeaderFooter(fileName)

Call setPrintPreview(fileName)

'指定したエクセルファイルを保存して閉じる

Workbooks(fileName).Save

Workbooks(fileName).Close

'マクロ実行中の画面表示を元に戻す

Application.ScreenUpdating = True

'完了メッセージを表示

MsgBox filePath + "の編集が完了しました"

End Sub

'-----------------------------------------------------------

' 機能: 引数で指定したエクセルファイルを開く

' 引数: filePath/ファイルパス、fileName/ファイル名

' 返り値: openExcel/ファイルを開けたかどうか

'-----------------------------------------------------------

Function openExcel(filePath As String, fileName As String)

'ファイルが存在しなければ、処理を終了する

If fileName = "" Then

MsgBox filePath + "が存在しません、処理を終了します"

openExcel = False

Exit Function

End If

'ファイルがエクセルファイルでなければ、処理を終了する

With CreateObject("Scripting.FileSystemObject")

If .GetFile(filePath).Type <> "Microsoft Excel ワークシート" Then

MsgBox fileName + "はエクセルファイルではありません、処理を終了します"

openExcel = False

Exit Function

End If

End With

'指定したファイルが開いていれば、処理を終了する

Dim wb As Workbook

For Each wb In Workbooks

If wb.Name = fileName Then

MsgBox fileName + "が既に開いています、処理を終了します"

openExcel = False

Exit Function

End If

Next wb

'指定したファイルを開く

Workbooks.Open filePath

openExcel = True

End Function

'-------------------------------------------------------------------

' 機能: 引数で指定したエクセルファイルのヘッダーとフッターを編集する

' 引数: fileName/ファイル名

' 返り値: なし

'-------------------------------------------------------------------

Sub setHeaderFooter(fileName As String)

Dim ws As Worksheet

For Each ws In Worksheets

With Workbooks(fileName).Sheets(ws.Name).PageSetup

.CenterHeader = fileName & "／" & ws.Name 'ヘッダーの中央はファイル名／シート名

.CenterFooter = "&P/&N" 'フッターの中央は現在のページ数/総ページ数

End With

Next ws

End Sub

'---------------------------------------------------------------

' 機能: 引数で指定したエクセルファイルの印刷プレビューを編集する

' 引数: fileName/ファイル名

' 返り値: なし

'---------------------------------------------------------------

Sub setPrintPreview(fileName As String)

Dim ws As Worksheet

For Each ws In Worksheets

With Workbooks(fileName).Sheets(ws.Name).PageSetup

.Orientation = xlLandscape '印刷の向きは横

.Zoom = False '拡大率・縮小率は設定しない

.FitToPagesTall = False '縦方向は指定しない

.FitToPagesWide = 1 '横方向は1シートにする

End With

Next ws

End Sub

上記ソースコードは、前提条件のプログラムと比べ、指定したエクセルファイルの編集処理を、ヘッダー・フッター・印刷プレビューを編集する処理に変更している。また、エクセルの編集処理を早くするため、Application.ScreenUpdatingを更新する処理も追加している。

なお、実際に作成したVBAファイルの内容は、以下のサイトを参照のこと。
https://github.com/purin-it/vba/tree/master/excel-vba-set-printtype

サンプルプログラムの実行結果

サンプルプログラムの実行結果は、以下の通り。

1) 編集処理を行う「C:\tmp\テスト２.xlsx」の、プログラム実行前の印刷プレビュー結果の先頭2ページは以下の通りで、ヘッダーやフッターの設定は無く、印刷プレビューも崩れた状態になっている

2) 編集ファイル名を指定し、「編集」ボタンを押下

3) 編集処理が完了すると、以下のメッセージが表示される

4) 編集処理を行った「C:\tmp\テスト２.xlsx」の、プログラム実行後の印刷プレビュー結果（1シート目）は以下の通りで、ヘッダーやフッターが設定され、印刷プレビューも横向き1シートに整えられた状態になっている

5) 編集処理を行った「C:\tmp\テスト２.xlsx」の、プログラム実行後の印刷プレビュー結果（2シート目）は以下の通りで、こちらも、ヘッダーやフッターや印刷プレビューの設定がされていることが確認できる

要点まとめ

Excel VBAでは、PageSetup オブジェクトを設定することで、ヘッダーやフッターを設定したり、印刷プレビューを変更したりできる。
Application.ScreenUpdatingをfalseに設定することで、マクロ実行中の画面表示が更新されないように設定でき、VBAの処理を早くすることができる。