【VBA】シートをPDFで出力する(ExportAsFixedFormat使用)
<機能>
(1)ExportAsFixedFormatを使用してシートをPDFで出力します
※ExportAsFixedFormatの対象はOffice 2013以降です
※マクロ実行時に必ずブックをマクロ有効形式(.xlsm)で保存してください
(2)サンプルの出力対象シートを自動で生成します
※コピペのみで動作確認できます
(3)印刷範囲、ヘッダー、フッターも自動で設定します
<動作検証&開発環境>
Microsoft Office2016
<実行イメージ>
サンプルの出力対象シートを自動で生成
ExportAsFixedFormatを使用してシートをPDFで出力
<使い方>
適当なところにソースを貼り付けてください
実行前にブックをマクロ有効形式(.xlsm)で保存してください
(400、1004などの実行エラーとなります)
PDF出力メイン() を実行すると処理を開始します
'********************************************
'シートをPDFで出力するサンプルプログラム
'(1)出力対象のサンプル明細書を自動生成
'(2)印刷範囲、ヘッダー、フッターを設定
'(3)PDFファイルを出力
'※ExportAsFixedFormatの対象:Office 2013 and later
'********************************************
Public Sub PDF出力メイン()
'//描画を停止
Application.ScreenUpdating = False
'//(1)出力対象のサンプル明細書を自動生成
サンプル明細書作成
'//(2)印刷範囲、ヘッダー、フッターを設定
'//PageSetupメンバーの詳細については Office DevCenter を参照
With ActiveSheet.PageSetup
'印刷の向き(横:xlLandscape 縦:xlPortrait)
.Orientation = xlLandscape
'横1ページ×縦1ページ
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
'ヘッダーを設定
'詳細は ヘッダーとフッターに指定できる書式コード 参照
'日付と現在時刻
.RightHeader = "印刷日時:&D(&T)"
'フッターを設定
'ページ番号
.CenterFooter = "&P/&N"
'ブック名とシート名
.RightFooter = "&F(&A)"
'余白設定
'上3、左1.5、右1.5、下2、ヘッダー2、フッター1
.TopMargin = Application.CentimetersToPoints(3)
.LeftMargin = Application.CentimetersToPoints(1.5)
.RightMargin = Application.CentimetersToPoints(1.5)
.BottomMargin = Application.CentimetersToPoints(2)
.HeaderMargin = Application.CentimetersToPoints(2)
.FooterMargin = Application.CentimetersToPoints(1)
'水平方向ページ中央
.CenterHorizontally = True
End With
'//改ページプレビュー表示
ActiveWindow.View = xlPageBreakPreview
'//ズーム100%で表示
ActiveWindow.Zoom = 100
'//(3)PDFファイルを出力
'//ファイル名にF4セルの氏名をセット(スペースはトリムする)
Dim strPdf As String
strPdf = ThisWorkbook.Path & "¥Meisai_" & Replace(Replace(Range("F4").Text, " ", ""), " ", "") & Replace(Replace(Replace(Now(), "/", ""), " ", ""), ":", "") & ".pdf"
'//PDFに変換する
'//ExportAsFixedFormatメソッドの詳細については Office DevCenter を参照
ThisWorkbook.Sheets(ThisWorkbook.ActiveSheet.Index).ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPdf, Quality:=xlQualityStandard
'//描画を再開
Application.ScreenUpdating = True
End Sub
'********************************************
'PDF出力対象のサンプル明細書を生成
'(1)サンプルデータをセット
'(2)帳票の体裁を自動で設定
'********************************************
Public Sub サンプル明細書作成()
Dim ar As Variant
ar = Array( _
"経費明細書,,,,,,,,", _
"サンプル株式会社 総務部,,,,,,,,", _
"〒000-0000 東京都新宿区西新宿1丁目,,,,,,,,", _
"電話,(03)9999-9999,,氏名,山田 太郎,,,,", _
"FAX,(03)9999-9998,,部署,営業部,,,,", _
"電子メール,info@abcdef.com,,職位,管理責任者,,,,", _
"Web,www.abcdef.com,,上司,鈴木 イチロウ,,,,", _
",,,,,,,,", _
"日付,勘定科目,内容,宿泊費,交通費,食費,通信費,雑費,合計", _
"43070,営業経費,旅費,44500,22500,2000,,500,69500", _
"43085,営業経費,営業会議,,13500,,,,13500", _
"43092,営業経費,営業会議,,13500,,1600,,15100", _
"合計,,,44500,49500,2000,1600,500,98100")
'//シートをクリア
ThisWorkbook.Activate
Cells.Select
Selection.Clear
Selection.ColumnWidth = 20
Selection.RowHeight = 25
Selection.Font.Name = "メイリオ"
Selection.Font.Size = 11
Selection.Borders.LineStyle = False
'//セルの折り返しを解除
Selection.WrapText = False
'//列幅調整
Columns("A").ColumnWidth = 3
'//帳票タイトル調整
With Rows("1")
.RowHeight = 40
.VerticalAlignment = xlTop
.Font.Size = 25
.Font.Bold = True
End With
'//データをシートに展開
Dim i As Integer, j As Integer
Dim wkbuf As Variant
For i = 0 To UBound(ar)
wkbuf = Split(ar(i), ",")
'不正なデータであれば次レコードへ
If UBound(wkbuf) <> 8 Then GoTo nextrec
'データを表示
For j = 0 To UBound(wkbuf)
'表示はB列からのため(j + 1)とする
Cells(i + 1, (j + 1) + 1) = wkbuf(j)
Next j
nextrec:
Next i
'//セルにインデントを設定
With Range("C4:C7,F4:F7")
.IndentLevel = 1
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
End With
'//表に罫線を引く
With Range("B9:J13")
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
'//項目行を中央揃えにする
With Range("B9:J9")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.Color = RGB(128, 128, 128)
.Font.Color = RGB(255, 255, 255)
End With
'//合計行の設定
With Range("B13:J13")
.Interior.Color = RGB(217, 217, 217)
.Font.Bold = True
End With
With Range("B13")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'//金額書式設定(円マーク付き、カンマ区切り)
Range("E10:J13").NumberFormatLocal = "¥#,##0; ¥-#,##0"
'//日付書式設定(YYYY年MM月DD日形式)
With Range("B10:B12")
.NumberFormatLocal = "yyyy""年""mm""月""dd""日"""
.HorizontalAlignment = xlCenter
End With
Range("A1").Select
End Sub
よろしければポチッと押してください