ExcelVBA

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

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

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

前提条件

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

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



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

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

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
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
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
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

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

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



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

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

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

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

2) 編集ファイル名を指定し、「編集」ボタンを押下
サンプルプログラムの実行結果_2

3) 編集処理が完了すると、以下のメッセージが表示される
サンプルプログラムの実行結果_3



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

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

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

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

要点まとめ

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