【VBA】シートをPDFで出力する(ExportAsFixedFormat使用)

0

    <機能>

    (1)ExportAsFixedFormatを使用してシートをPDFで出力します

     ※ExportAsFixedFormatの対象はOffice 2013以降です

     ※マクロ実行時に必ずブックをマクロ有効形式(.xlsm)で保存してください

    (2)サンプルの出力対象シートを自動で生成します

     ※コピペのみで動作確認できます

    (3)印刷範囲、ヘッダー、フッターも自動で設定します

     

    <動作検証&開発環境>
    Microsoft Office2016

     

    <実行イメージ>

    サンプルの出力対象シートを自動で生成

    VBA,PDF,ExportAsFixedFormat,印刷範囲,PDF変換,PDF出力,

    ExportAsFixedFormatを使用してシートをPDFで出力

    VBA,PDF,ExportAsFixedFormat,印刷範囲,PDF変換,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

     

    よろしければポチッと押してください

    プログラマー ブログランキングへ



    selected entries

    categories


    プログラマー ブログランキングへ

    calendar

    S M T W T F S
       1234
    567891011
    12131415161718
    19202122232425
    262728293031 
    << March 2017 >>

    profile

    others

    mobile

    qrcode