[[20230423220958]]　『Excelでハイパーリンク先のPDFを印刷するマクロを』（よすい）　ページの最後に飛ぶ

『Excelでハイパーリンク先のPDFを印刷するマクロをつくりたいです』（よすい）

ブック名「ブライト」
シート名「指図書」
ハイパーリンク挿入セル「f9」
※リンクはフルパスで表示されている
PDFが格納されているフォルダ「データ」
※「データ」の場所はデスクトップ上

f9にはハイパーリンク関数が入っており、
f7の文字列と連動してパス名が変わる仕組みとなっている。

この条件でf9のハイパーリンクを開き自動で印刷するマクロをつくりたいです。
アドバイスをお願いいたします。

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

コードです。

 Set objAdobe = CreateObject("AcroExch.App")
でうまくいきません。インターフェースが対応してないとかなんとか…
参照設定やAcrobatはインストール済みです。

Sub PrintPDF()

    'ファイルパスを取得
    filePath = Sheets("指図書").Range("F9").Value

    'Acrobat Readerを起動し、PDFファイルを開く
    Set objAdobe = CreateObject("AcroExch.App")
    Set objAcrobat = CreateObject("AcroExch.AVDoc")
    objAcrobat.Open filePath, "Acrobat"

    'PDFファイルを印刷する
    objAcrobat.PrintPagesSilent 1, 1

    'Acrobat Readerを終了する
    objAcrobat.Close True
    objAdobe.Exit
End Sub
```
（よすい） 2023/04/23(日) 22:33:06

 AcrobatReaderしか持ってないので、十分かどうかわかりませんが・・・
 手持ちの道具を使った場合、こんな感じで印刷できると思います。

 ページ枚数の指定方法が分からないので、PDFのページ枚数全部印刷されます。
 クラスモジュールはごちゃごちゃしていますが、参考にしたサイトはURL載せてありますので、
 必要なところだけ抜粋して使っていただければと思います。

 クラスモジュールを追加して、以下のコードを入れる
 オブジェクト名は　cls_PDFPrint　としておく
    '■クラスモジュール
    Option Explicit
    'cls_PDFPrint
    Private objShell             As Object  'WScript.Shellのオブジェクト
    Private Acrobatパス_cls      As String  'アクロバットのパスを保存する
    Private Path設定可否_cls     As Boolean 'アクロバットのパスが通ったか判断する　TrueはOK、FlaseがNG
    Private ファイル毎印刷数_cls As Long    '印刷指示されたファイルの個数をカウントする
    Private 印刷総枚数_cls       As Long    '印刷枚数で指定された枚数をカウントする
    Private dic印刷失敗_cls      As Object  'Dictionaryオブジェクト　印刷失敗時に、パスをkeyに入れる

    Private Sub Class_Initialize()
        Dim パス候補 As Variant
        Set objShell = CreateObject("WScript.Shell")
        '■アクロバットの実行ファイルパスを検索　2022/1現在、2パターン
        On Error Resume Next
        For Each パス候補 In Array("Acrobat.exe", "AcroRd32.exe")
            Acrobatパス_cls = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & パス候補 & "\")
            If Acrobatパス_cls <> "" Then Exit For
        Next パス候補
        On Error GoTo 0
        If Acrobatパス_cls = "" Then
            Path設定可否_cls = False
        Else
            Acrobatパス_cls = """" & Acrobatパス_cls & """" & " /t " 'ダブルクコーテーションで括り、引数を付ける
            Path設定可否_cls = True
        End If
        Set dic印刷失敗_cls = CreateObject("Scripting.dictionary")
        'https://qiita.com/takiru/items/f38e94e666e802fa9a25
        'http://pdf-file.nnn2.com/?p=222
        'https://misora05.hatenablog.com/entry/2019/06/15/040628
    End Sub

    Public Function PrintOut_bool(ByVal ファイルパス As String, Optional 印刷枚数 As Long = 1) As Boolean
        '■印刷実行プログラム
        Dim i As Long
        'ファイルパスのチェック
        If Dir(ファイルパス) <> "" Then
            On Error GoTo err
            '印刷枚数に従って、既定のプリンターで印刷
            For i = 1 To 印刷枚数
                objShell.Run Acrobatパス_cls & """" & ファイルパス & """"
                印刷総枚数_cls = 印刷総枚数_cls + 1
            Next i
            ファイル毎印刷数_cls = ファイル毎印刷数_cls + 1
            PrintOut_bool = True
        Else
            'パスがなかったか、それ以外のエラーで失敗したときにDictionaryにパスを追加
    err:
            dic印刷失敗_cls(ファイルパス) = ""
            PrintOut_bool = False
        End If
        On Error GoTo 0
    Rem execでオブジェクトを取得しても、印刷の成否は不明だった。
    Rem 最終的に、印刷した部数と実際に印刷された部数が一致するか最後に確認する必要はあるかもしれない。
    Rem acrobatのアップデートが実行している場合は、印刷されないことがあるので、気を付けたい。
    End Function
    '各種プロパティーの出力
    Public Property Get Acrobatパス_str() As String
        Acrobatパス_str = Acrobatパス_cls
    End Property
    Public Property Get Path設定可否_bool() As Boolean
        Path設定可否_bool = Path設定可否_cls
    End Property
    Public Property Get ファイル毎印刷数_long() As Long
        ファイル毎印刷数_long = ファイル毎印刷数_cls
    End Property
    Public Property Get 印刷失敗数_long() As Long
        印刷失敗数_long = dic印刷失敗_cls.Count
    End Property
    Public Property Get 印刷失敗パス一覧_ary() As Variant
        印刷失敗パス一覧_ary = dic印刷失敗_cls.keys
    End Property
    Private Sub Class_Terminate()
        Set objShell = Nothing
        Set dic印刷失敗_cls = Nothing
    End Sub

    '■標準モジュール
    Option Explicit
    Sub PDF印刷()
        Dim pdf As cls_PDFPrint
        Dim filePath As String
        'ファイルパスを取得
        filePath = Sheets("指図書").Range("F9").Value

        If MsgBox("1.アクロバットが閉じていることを確認してください" & vbCrLf & _
                  "2.右記のプリンターで印刷します（規定プリンタ）" & ActivePrinter & vbCrLf & _
                  "上記に問題がなければ　はい　を押してください", vbYesNo) = vbNo Then Exit Sub
        Set pdf = New cls_PDFPrint
        If pdf.Path設定可否_bool = False Then
            MsgBox "アクロバットがインストールされていないか、未知のバージョンです。管理者に問い合わせてください"
            Exit Sub
        End If

        '印刷処理
        If pdf.PrintOut_bool(filePath) = True Then
            MsgBox "印刷に成功しました"
        Else
            MsgBox "印刷に失敗しました"
        End If

        '共通処理
        Set pdf = Nothing
    End Sub
（稲葉） 2023/04/24(月) 08:58:29

 あ、F9の値がHYPERLINK関数の第二引数を入力していないことが前提で話進めてます。
 たぶん、F9の数式は
 =HYPERLINK("C:\Users\ユーザー名\Desktop\"&F7)
 こんな感じだと思ってます。

 それ以外だと
 filePath = Sheets("指図書").Range("F9").Value
 この部分工夫しないといけないです。
（稲葉） 2023/04/24(月) 09:12:27

コメント返信：

[ 一覧(最新更新順) ]

[[20230423220958]] 『Excelでハイパーリンク先のPDFを印刷するマクロを』（よすい） ページの最後に飛ぶ

[[20230423220958]]　『Excelでハイパーリンク先のPDFを印刷するマクロを』（よすい）　ページの最後に飛ぶ