　こんにちは。

　VBAを使うことが、頻繁ではないですが、ちょくちょくあり、

　その都度「コードってこれで良かったっけ？」「どう書くんだっけ？」

　となることが、しばしば、、、あります。

　その時その時で調べて、確認して、コードを書いてとしていたので、

　自分が使いやすいように、コードをコピペで使えるようにまとめます。

内容

　エクセルファイル内の全てのsheetを個別のファイルとしてPDF化します。

　下記のようなファイルを準備しました。

　エクセルファイル内に、シートを4つ作りました。

赤枠で囲ったシート毎でPDF化していきます。

コード

　コードを以下に示します。

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'Date:          20/12/2
'Contents:      選択したフォルダ内に全シートのPDFファイルを作成する
'Argument:      無し
'RValue:        無し
'Author:
'Update:　      ▲1：yy/mm/dd　XXXの処理をXXXに変更した
'
'remaarks:
'remaarks:
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'
Sub subMakeAllPDFFile()
    
    '変数の宣言
    Dim strFolderPath As String
    Dim strSaveFilePath As String
    
    
    '保存するフォルダ選択
    strFolderPath = funcSelecteFolder()
    
    'ワークシート内の全シートをPDF化する
    For i = 1 To Worksheets.Count
        strSaveFilePath = strFolderPath + "\" + Worksheets(i).Name + ".pdf"
        'MsgBox strSaveFilePath
        Worksheets(Worksheets(i).Name).Activate
        Call funcMakePDF(strSaveFilePath)
    Next i
    
    
End Sub

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'Date:          20/12/2
'Contents:      フォルダを選択するコード、選択ダイヤログを起動し、フォルダ選択へ
'Argument:      無し
'RValue:        無し
'Author:
'Update:　      ▲1：yy/mm/dd　XXXの処理をXXXに変更した
'
'remaarks:
'remaarks:
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'
Function funcSelecteFolder() As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        '初期表示フォルダの設定

        If .Show = -1 Then  'ファイルダイアログ表示
            ' [ OK ] ボタンが押された場合
            
            '関数の戻り値をセット
            funcSelecteFolder = vbLf & .SelectedItems(1)
            funcSelecteFolder = Right(funcSelecteFolder, Len(funcSelecteFolder) - 1)
        Else
            ' [ キャンセル ] ボタンが押された場合
            MsgBox "フォルダ選択がキャンセルされました。", vbExclamation
            End
        End If
    End With


End Function

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'Date:          20/12/2
'Contents:      PDFデータを作る
'Argument:      無し
'RValue:        無し
'Author:
'Update:　      ▲1：yy/mm/dd　XXXの処理をXXXに変更した
'
'remaarks:
'remaarks:
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'
Function funcMakePDF(strFilePass As String)

    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strFilePass, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Function

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

'Date: 20/12/2

'Contents: 選択したフォルダ内に全シートのPDFファイルを作成する

'Argument: 無し

'RValue: 無し

'Author:

'Update:　 ▲1：yy/mm/dd　XXXの処理をXXXに変更した

'remaarks:

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

Sub subMakeAllPDFFile()

'変数の宣言

Dim strFolderPath As String

Dim strSaveFilePath As String

'保存するフォルダ選択

strFolderPath = funcSelecteFolder()

'ワークシート内の全シートをPDF化する

For i = 1 To Worksheets.Count

strSaveFilePath = strFolderPath + "\" + Worksheets(i).Name + ".pdf"

'MsgBox strSaveFilePath

Worksheets(Worksheets(i).Name).Activate

Call funcMakePDF(strSaveFilePath)

Next i

End Sub

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

'Date: 20/12/2

'Contents: フォルダを選択するコード、選択ダイヤログを起動し、フォルダ選択へ

'Argument: 無し

'RValue: 無し

'Author:

'Update:　 ▲1：yy/mm/dd　XXXの処理をXXXに変更した

'remaarks:

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

Function funcSelecteFolder() As String

With Application.FileDialog(msoFileDialogFolderPicker)

'初期表示フォルダの設定

If .Show = -1 Then 'ファイルダイアログ表示

' [ OK ] ボタンが押された場合

'関数の戻り値をセット

funcSelecteFolder = vbLf & .SelectedItems(1)

funcSelecteFolder = Right(funcSelecteFolder, Len(funcSelecteFolder) - 1)

Else

' [ キャンセル ] ボタンが押された場合

MsgBox "フォルダ選択がキャンセルされました。", vbExclamation

End

End If

End With

End Function

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

'Date: 20/12/2

'Contents: PDFデータを作る

'Argument: 無し

'RValue: 無し

'Author:

'Update:　 ▲1：yy/mm/dd　XXXの処理をXXXに変更した

'remaarks:

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

Function funcMakePDF(strFilePass As String)

ActiveSheet.ExportAsFixedFormat _

Type:=xlTypePDF, _

Filename:=strFilePass, _

Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

End Function

なぜか、文字のカラーがおかしくなる、、、

コードを実行

　コードを実行すると、最初に下図のようなダイヤログが起動し、保存先のフォルダを問われます。

　保存先フォルダを選んだら、フォルダの中にPDFファイルを作成します。

　エクセルから資料を作る際は、使えると思いまとめました！

自分のためのVBA　エクセルファイル内の全てのsheetを個別ファイルとしてPDF化する

内容

コード

コードを実行

コメントを残すコメントをキャンセル

自分のためのVBA エクセルファイル内の全てのsheetを個別ファイルとしてPDF化する

内容

コード

コードを実行

Related posts:

コメントを残す コメントをキャンセル

自分のためのVBA　エクセルファイル内の全てのsheetを個別ファイルとしてPDF化する

コメントを残すコメントをキャンセル