[[20200129141648]]　『【VBA】PDF出力時のファイル名に連番をつけたい』（雪ん子）　ページの最後に飛ぶ

『【VBA】PDF出力時のファイル名に連番をつけたい』（雪ん子）

質問させていただきます。
印刷範囲をPDFに出力するマクロを使用しており、ファイル名を指定したセルに入力した名前になるようにしています。
同じ名前で複数のファイルを作成することもあり、指定したファイル名の後に連番をつけたいのですが、どのようなコードを追加すればよいでしょうか？

例えば、AO3に元となるファイル名「ファイル」が入力されていたとして、出力されたPDFは「ファイル01」となり、続いて出力したら「ファイル02」という具合にしたいのです。

Sub PDF出力()
Dim FileName As String
Dim FilePath As String
Dim FSO As Object
FileName = ThisWorkbook.Name
Set FSO = CreateObject("Scripting.FileSystemObject")
FileName = FSO.getbasename(FileName)
FilePath = ThisWorkbook.Path & "\"
Worksheets("Sheet1").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=FilePath & Range("AO3").Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

適当なシートの適当なセルに数字をメモしておき、出力するたびに＋1して、ファイル名の後ろにくっつけてみてはどうでしょうか。

（もこな２） 2020/01/29(水) 14:43

番号を記憶しておくのとは別案で、既に存在する似たファイル名の数を数えて、その数+1で採番する、という手もあります。

 Sub test()
    Dim FileName As String
    Dim FilePath As String
    Dim FSO As Object
    Dim OBJ As Object
    Dim iCou As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileName = FSO.getbasename(ThisWorkbook.Name)
    FilePath = ThisWorkbook.Path & "\"

    For Each OBJ In FSO.GetFolder(FilePath).Files
        If OBJ.Name Like Range("AO3").Value & "*.pdf" Then
            iCou = iCou + 1
        End If
    Next OBJ

    Worksheets("Sheet1").ExportAsFixedFormat Type:=xlTypePDF, _
        FileName:=FilePath & Range("AO3").Value & IIf(iCou = 0, "", "_" & iCou + 1) & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
 End Sub
（???） 2020/01/29(水) 15:26

ファイル数カウントの場合、手動で作成したファイルの前の方を削除すると、同じ番号を生成するので、手動削除が考えられるならば、もう少し工夫が必要になります。例えば、それぞれの更新日時をチェックし、一番新しいファイルを採用。拡張子の前に定型で番号があれば、それを抜き出して数値化し、+1する、とか。

または、On Error Resume Next を仕込んでおいて、エラーの場合は更に+1して保存し直すとか。どこまで凝るかは、お好きにどうぞ。
（???） 2020/01/29(水) 15:33

???様

＞番号を記憶しておくのとは別案で、既に存在する似たファイル名の数を数えて、その数+1で採番する、という手もあります。

言葉が足りずすみませんが、私がやりたかったのはこのことでした。
大変助かりました。
ありがとうございます。
（雪ん子） 2020/01/29(水) 15:51

もう一つ質問させていただきたいのですが、保存する際の用紙のサイズ指定のコードをどこに挟めばよいかも教えていただければ助かります。

WorkSheets("Sheet1").PageSetup.PaperSize = xlPaperB5

これで合っているかも自信ないですが…
（雪ん子） 2020/01/29(水) 16:39

用紙サイズ変更はそれで合ってますし、何処に入れても構いませんが、そもそも用紙サイズはシート毎に「ページレイアウト」－「サイズ」で変えておけば良い話ではないでしょうか？印刷の度に変更する訳ではないでしょう？
（???） 2020/01/29(水) 17:19

んー。。。

フリーソフトを利用して、同名のファイルがあったとき「上書き」しないに設定しておけば、
マクロで悩まなくてもいいのですけど。。。

自作するなら、まず自作関数を作ってみるところから始めてみてはいかがでしょう？
ブラックボックスという言葉はご存知でしょうか？

それを自分が作るイメージです。

例えば、

「てすと」と文字列を与えたら「てすと(1)」と文字列で返す
「ですと(1)]と与えたら「てすと(2)」と返す

というような仕様を考え、
それを実現するための仕組み（作業の流れ）を作ればいいと思います。

それが出来たら、
本体のプログラムからその関数を呼び出せばいいわけです。

（まっつわん） 2020/01/30(木) 09:16

も少し書くと、

＞FileName = FSO.getbasename(FileName)

ファイル名から拡張子を取り除いた名前を
ファイルシステムオブジェクトのgetbasenameメソッドを用いて取得されているわけですが、
単に
与えた文字列の中の、ピリオドより後ろの文字列を取り除いて返しているだけですよね？
getbasenameメソッドがどのように作業しているかは解らないですが（解る必要もないわけですが）、
同じ仕組みは結構簡単に自分で作れますよね？（そんなに簡単ではないかもしれませんが。）

Sub test()

    Set FSO = CreateObject("Scripting.FileSystemObject")
    MsgBox FSO.getBasename("Book1.xlsx")
End Sub

Sub test2()

    MsgBox orgBaseName2("Book1.xlsx")
End Sub

Function orgBaseName2(sName As String) As String

    Dim i As Long

    i = InStr(1, sName, ".")
    orgBaseName2 = Left(sName, i - 1)
End Function

このようにorgBaseName2というような仕組みを作ってやればいいわけですが、
そうなると、マクロの記録とネット上のサンプルを見るだけでは作れないと思うので
（探せば、掲示板の過去ログやネット上にサンプルコードがあるかも知れませんが）、
VBAを基礎から勉強する（今回の件の場合は文字列の操作に関する関数が中心）ということ
になると思います。
（まっつわん） 2020/01/30(木) 09:42

残念ながら私の案は不採用だったみたいなのでそれ以外で。

まっつわんさんが、文字列操作の話をされていますが、提示されたコードだけみると、「FileName」を取得しただけでどこにも使ってないので、そもそも文字列操作する必要がない可能性があります。

おそらく最初に提示されたコードを整理するとこんな感じになります。（使ってない処理、既定値の指定を削除）

    Sub PDF出力_整理()
        With Worksheets("Sheet1")
            .ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=ThisWorkbook.Path & "\" & .Range("AO3").Value & ".pdf", _
                IncludeDocProperties:=True, _
                OpenAfterPublish:=True
        End With       
    End Sub

つまり、実質的には1行で済むはずなのに要らない操作をしています。

おそらく、ネットの記事等を参考にコピペに近い状態で組まれたのでしょうけど、一度ステップ実行をしてみて、どの命令が何をしているのかというのをチェックしてみるとよいとおもいます。

さらに、元々1行で済むのでページ設定するなら、「ExportAsFixedFormat」の前に入れるしかありません。
ただ、???さんが指摘されているように、そのページがB5サイズで出力することが前提であれば、元からB5に設定しておけばよい話ですし、逆に普段は別サイズなんだけどPDF出力するときだけB5にしたいということなら、変更する【前に】今の設定を覚えておき、「ExportAsFixedFormat」【後に】戻さないとダメです。

踏まえて、???さんが示されているように、ファイルがある場合は＋１して再トライするというアイデアを私なりに再現するとこんな感じです。
興味があればステップ実行して研究のうえ、必要な部分のみご自身のコードに取り入れてください。

    Sub PDF出力整理()
        Dim i As Long
        Dim ファイルぱす As String
        Dim 用紙サイズ待避 As Variant

        Stop '←ブレークポイントの代わり

        With Worksheets("Sheet1")

            '▼現在の用紙サイズを覚えてから変更
            用紙サイズ待避 = .PageSetup.PaperSize
            .PageSetup.PaperSize = xlPaperB5

            '▼1～99まで順番にファイルがあるかチェック
            For i = 1 To 99
                ファイルぱす = ThisWorkbook.Path & "\" & .Range("AO3").Value & Format(i, "00.pdf")

                '▼使ってない番号が見つかったらそこで確認終了
                If Dir(ファイルぱす) = "" Then Exit For
            Next i

            '▼PDF出力
            .ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=ファイルぱす, _
                IncludeDocProperties:=True, _
                OpenAfterPublish:=True

            '▼用紙サイズを元に戻す
            .PageSetup.PaperSize = 用紙サイズ待避

        End With
    End Sub

（もこな２） 2020/01/30(木) 11:26

コメント返信：

[ 一覧(最新更新順) ]

[[20200129141648]] 『【VBA】PDF出力時のファイル名に連番をつけたい』（雪ん子） ページの最後に飛ぶ

[[20200129141648]]　『【VBA】PDF出力時のファイル名に連番をつけたい』（雪ん子）　ページの最後に飛ぶ