[[20181225152707]]　『ファイル名をシート名に変更する』（zunzun）　ページの最後に飛ぶ

『ファイル名をシート名に変更する』（zunzun）

いつもお世話になっております。

下記のマクロを作成して、ドキュワークスプリンターへの印刷ができています。印刷後のファイル名は、エクセルのファイル名になっています。これを
シート名（G4セル）に変更したいのですが、方法が良く分かりません。何かヒントを頂けないでしょうか？

Sub 保存()

If MsgBox("経費精算管理番号を入力ましたか？シートコピーを実行しますか？", vbOKCancel) = vbCancel Then

     Exit Sub
   End If
   'OKの場合の処理

Worksheets("作成シート").Copy after:=Worksheets(Worksheets.Count) ' 末尾にコピー
ActiveSheet.Name = Range("G4") ' シート名を管理番号に変更

Dim pn As String

    pn = Application.ActivePrinter
    ActiveSheet.PrintOut , ActivePrinter:="DocuWorks Printer"
    Application.ActivePrinter = pn

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

ヒントだけで恐縮です。
本体であれ新規作成であれ、ともかく
付けたい名前でファイルを保存すれば良い様に思いますです。
でわ

（隠居じーさん） 2018/12/25(火) 16:44

 SaveAsメソッド を調べてみてください。
（TAKA） 2018/12/25(火) 17:20

TAKAさん
　ヒントありがとうございました。
　質問した後に、校内を検索していたら、20150820160811　で同様な質問をされている方がいました。
　この中では、自動ではできないとの回答がなされていました。マクロなら出来るのかが判然としませんが・・・　SaveAs　調べてみます。
（zunzun） 2018/12/25(火) 17:31

[[20150820160811]]　『エクセルからドキュワークスに印刷する際にシート』（青）　>>BOT

 これかな？

 でも、シートをコピーして～～ってなると、自動化できないですもんね。
 デフォルトで保存されるなら、あとで名前を変えてしまえという発想で、こんなのいかがですか？

    Sub 保存()
        Dim DefaultPrinter As String
        Dim FilePath As String
        Dim SheetName As String
        Const FolderPath As String = "C:\Users\" '◆ここのパスをDocuWorks Printerの保存先に変更してください。
        FilePath = FolderPath & ThisWorkbook.Name

        If MsgBox("経費精算管理番号を入力ましたか？シートコピーを実行しますか？", vbOKCancel) = vbOK Then
            'シート名の取得、コピー
            With Sheets("作成シート")
                SheetName = .Range("G4").Value
                .Copy after:=Sheets(Sheets.Count) ' 末尾にコピー
            End With

            '使用中のプリンターを記録
            'コピーしたシート名の変更　#同名シートのチェック無し
            'シートをDocuWorks Printerで出力
            'アクティブプリンターを戻す
            DefaultPrinter = Application.ActivePrinter
            With Sheets(Sheets.Count)
                .Name = SheetName ' シート名を管理番号に変更
                .PrintOut , ActivePrinter:="DocuWorks Printer"
            End With
            Application.ActivePrinter = DefaultPrinter

            '名前の変更 #同名のファイルチェック無し
            Name FilePath As FolderPath & SheetName
        End If
    End Sub
（稲葉） 2018/12/25(火) 17:40

お～ぉとんだ勘違いを致しておりました。@@;
私のレスは取消とさせてくださいませ。
すみませんでした。
m(_　_)m
（隠居じーさん） 2018/12/25(火) 18:11

DocuWorks化をマクロから簡単にやる方法はありません。

若干強引ですが、方針は２つ考えられると思います。
１．ワークブック自体を目的の名前にSaveAsしてから印刷して、元の名前にSaveAsで戻す方法
２．とりあえず印刷して、印刷されたファイルをリネームする方法
３．DocuWorksAPIを使用する方法

１については文字通りのシンプルな方法で、スピードは遅いですが一番カンタンです。

２についてはDocuWorksの印刷が非同期なので「印刷が完了した」ことを検知する難易度高いです。
たとえば、稲葉さん方式ではNameステートメント実行前にDo～Loopで目的のファイルが生成されファイルのロックが解除されるまでを監視するループが必要です。

しかしDocuWorksの方で特定文字を切り落とすとか改名する処理が入っていると、永久に生成されませんから無限ループ対策も必要になります。
その辺の勝手な変更を防ぐため、まずDocuWorksプリンタの印刷設定のオプションをいくつかOFFにしておくほうが良いと思います。色々試してみて下さい。

印刷に失敗して強制終了した場合も考える必要があります。

３がおそらく最適解なのですが私もやったことがないのでわかりませんが、検索すると少しだけサンプルが出てきたので、かなり頑張れば出来るかもしれません。
（名無し） 2018/12/25(火) 18:38

職場のパソコンにドキュワークスが入っていたのでちょっと試してみたところ、PDFプリンタとして使うとファイル名は聞かれず、いきなりファイルが作成されるっぽいです。

そして、私には稲葉さんのようにファイル名の方を変更するという発想がなかったので。ブック名の方を何とかしてしまおうと、以下のように考えてみました。

    Sub 保存_改()

        Dim MySTR As String
        Dim pn As String
        Dim MyFile As String
        Dim i As Integer

        If MsgBox("経費精算管理番号を入力ましたか？" & vbCrLf & _
                  "シートコピーを実行しますか？", vbOKCancel) = vbCancel Then Exit Sub

        'OKの場合、処理を継続
        MySTR = Worksheets("作成シート").Range("G4").Value

        Worksheets("作成シート").Copy after:=Worksheets(Worksheets.Count) ' 末尾にコピー

        ' 末尾にコピーされたシートの処理
        With Worksheets(Worksheets.Count)
            .Name = MySTR ' シート名を管理番号に変更
            .Copy '末尾のシートを新規ブックへコピー
        End With

        'シートコピーで作成された新規ブックの処理
        With Workbooks(Workbooks.Count)

            '新規ブックに名前を付けて保存して、フルパスを変数に格納
            .SaveAs Filename:=ThisWorkbook.Path & "\" & MySTR
            MyFile = .FullName

            'ドキュワークスの処理
            pn = Application.ActivePrinter
            .Worksheets(1).PrintOut , ActivePrinter:="DocuWorks Printer"
            Application.ActivePrinter = pn

            'ブックを閉じる
            .Close
        End With

        '用済みになったブックの削除処理
        i = FreeFile
        On Error Resume Next
        Do
            Err.Clear
            DoEvents
            Open MyFile For Append As #i
            Close #i
        Loop While Err.Number > 0
        On Error GoTo 0

        Kill MyFile

    End Sub

結果として、名無しさんの１案に近いですかね。

このほか気になるのは、お使いのバージョンがExcel2010ということなので、標準でFDF形式保存できる機能が追加されているとおもいます。
なので、単純にPDFファイルがほしいだけとかだったら、そちらで対応できちゃうような気がしなくもないです。
既に検討した結果NGだったということであれば余計な一言失礼しました。

（もこな２） 2018/12/26(水) 01:20

 ただのPDFなんですか？
 であれば、エクスポートでいいんでは？

    Sub 保存()
        Dim SheetName As String
        Const FolderPath As String = "C:\Users\" '◆ここのパスをDocuWorks Printerの保存先に変更してください。

        If MsgBox("経費精算管理番号を入力ましたか？シートコピーを実行しますか？", vbOKCancel) = vbOK Then
            'シート名の取得、コピー
            With Sheets("作成シート")
                SheetName = .Range("G4").Value
                .Copy after:=Sheets(Sheets.Count) ' 末尾にコピー
            End With

            'コピーしたシート名の変更　#同名シートのチェック無し
            'シートをPDFでエクスポート #問答無用で上書き
            'https://docs.microsoft.com/ja-jp/office/vba/api/excel.workbook.exportasfixedformat
            With Sheets(Sheets.Count)
                .Name = SheetName ' シート名を管理番号に変更
                .ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    Filename:=FolderPath & SheetName, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
            End With
        End If
    End Sub
（稲葉） 2018/12/26(水) 08:32

各位　殿
ドキュワークスは、ハードルが高いんですね。総務への提出は、PDF又はXDWなので、簡単なPDFで処理することに変更しました。稲葉さんに提案いただいたコードでバッチリでした。色々なヒント（最後はコードまで）を教えていただき、深謝です。ありがとうございました。

（zunzun） 2018/12/26(水) 10:27

コメント返信：

[ 一覧(最新更新順) ]

[[20181225152707]] 『ファイル名をシート名に変更する』（zunzun） ページの最後に飛ぶ

[[20181225152707]]　『ファイル名をシート名に変更する』（zunzun）　ページの最後に飛ぶ