[[20231226164619]]　『Docuworks Printerで印刷時ブック名を変更したい』（Docuworks Printer）　ページの最後に飛ぶ

『Docuworks Printerで印刷時ブック名を変更したい』（Docuworks Printer）

お世話になっております

Docuworks PrinterでExcelのブックを印刷（Docworksへ出力？）すると
Docworks上に表示される名前がブックの名前になってしまいます

任意の名前を付けたいと思い、いろいろ調べてみましたがギブアップです
申し訳ありませんが、助けてください

名無しさんの提案している１の方法がやりたいことです
https://www.excel.studio-kazu.jp/kw/20181225152707.html

Docuworks Printerの設定は下記URLを参考に削除しないにしてあります
https://opencds-fb.fujifilm.com/gen/docuworks_aux/v9/help/jpn/desk/deskdf017-4.html

色々なサイトを見て考えたマクロは下記になります

Sub DocuWorksPrinter()

Dim SaveName As String
Dim desktop As String
Dim i As Long
Dim FileName As String

SaveName = Sheet1.Range("B2").Value
desktop = CreateObject("wscript.shell").specialfolders("desktop") & "\Local"

FileName = desktop & "\" & "DocWP：" & SaveName & ".xlsm"

Do While Dir(FileName) <> ""
i = i + 1
FileName = desktop & "\" & "DocWP：" & SaveName & Format(i, "(0)") & ".xlsm"
Loop

ThisWorkbook.SaveCopyAs FileName:=FileName

End Sub

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

 自分も初めて使ったのですが、リンク先の「３．DocuWorksAPIを使用する方法」でしたら、
うまく動作しているようなので、提案できます。
 但し、質問者さんの環境が以下であることが条件です。
 又、自分が使っているDocuWorksはVer7.1と古いので、バージョンの違いによってAPIが動作しないかもしれない
懸念は、あります。

 (1)DocuWorks Development Tool Kitがインストールされていること。
  これは、正規ユーザなら、富士フイルムのホームページからダウンロードできます。
https://www.fujifilm.com/fb/support/software/docuworks_9/info/contents/info_013.html

（まる2021） 2023/12/27(水) 01:11:20

まる2021 様

DocuWorks9.1を使用中です
正規ユーザーですが、上長の方針でDocuWorks Development Tool Kitは使わない方針のようです
名無しさんの１番目の提案を実現できるようにSaveAsをもう少し勉強します
ありがとうございました
（Docuworks Printer） 2023/12/27(水) 16:04:57

 返信、どうもです。了解しました。

 >名無しさんの１番目の提案を実現できるようにSaveAsをもう少し勉強します
 これに沿ったものを考えてみました。要所にコメントを入れてるので、それを読んで下さい。

 Sub Sample()
    Call WorkbookToDocuWorks(ThisWorkbook, Sheets("Sheet1").Range("A1").Value)
 End Sub

 '第1引数：Workbookオブジェクト
 '第2引数：保存ファイルのBaseName　「C:\xxx\yyy\abc.xdw」なら「abc」を指定
 '★部分をDocuWorks仮想プリンタの出力先に変更してください。
 Private Sub WorkbookToDocuWorks(wb As Workbook, xdwBaseName$)
    Const xdwFolderName$ = "C:\DocuWorksData\DWFolders\ユーザーフォルダ"    '★ご自身の環境に合わせて変更
    Dim FSO As Object
    Dim orgFullPath$, tmpFolder$, tmpFullPath$, xdwFullPath$, tmpBaseName$, i&
    '未保存ブックは処理しない
    If InStr(wb.FullName, "\") = 0 Then _
       MsgBox wb.FullName & vbCrLf & "未保存ブックです。障害に備えて先に保存して下さい！", vbCritical: Exit Sub
    orgFullPath = wb.FullName  'オリジナルのパスを変数に退避
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '保存先に同名がある場合は末尾にインクリメント
    xdwFullPath = FSO.BuildPath(xdwFolderName, xdwBaseName & ".xdw")
    Do While FSO.FileExists(xdwFullPath)
        i = i + 1
        tmpBaseName = xdwBaseName & Format(i, "(0)")
        xdwFullPath = FSO.BuildPath(xdwFolderName, tmpBaseName & ".xdw")
    Loop
    xdwBaseName = FSO.GetBaseName(xdwFullPath)
    '一時フォルダ作成
    tmpFolder = FSO.CreateFolder(FSO.GetSpecialFolder(2) & "\" & FSO.GetBaseName(FSO.GetTempName)).Path
    tmpFullPath = FSO.BuildPath(tmpFolder, xdwBaseName & "." & FSO.GetExtensionName(orgFullPath))
    Application.DisplayAlerts = False
    On Error GoTo ErrProc
    wb.Save    '障害に備えて、現在までの内容を保存
    wb.SaveAs tmpFullPath    '一時フォルダにSaveAs
    wb.PrintOut ActivePrinter:="DocuWorks Printer"    '印刷
    wb.SaveAs orgFullPath    'オリジナルのパスに復帰
    If FSO.FolderExists(tmpFolder) Then FSO.DeleteFolder tmpFolder    '一時フォルダ削除
    Exit Sub
ErrProc:
    MsgBox Err.Description, vbCritical
End Sub

（まる2021） 2023/12/27(水) 20:57:47

まる2021 様

私では到底考えられない、素晴らしいコードありがとうございます
分解してしっかり学習したいと思います
休暇中は自分の頭でマクロ考えて、あがいてみます

良い年末をお過ごし下さい
ありがとうございました
（Docuworks Printer） 2023/12/28(木) 09:42:39

コメント返信：

[ 一覧(最新更新順) ]

[[20231226164619]] 『Docuworks Printerで印刷時ブック名を変更したい』（Docuworks Printer） ページの最後に飛ぶ

[[20231226164619]]　『Docuworks Printerで印刷時ブック名を変更したい』（Docuworks Printer）　ページの最後に飛ぶ