Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14487 / 76734 ←次へ | 前へ→

【67741】PDFの作成について
質問  会社員  - 11/1/6(木) 11:50 -

引用なし
パスワード
   エクセルVBAにてセルに表示したPDFのファイル名を読み取って
PDFのページを増やしていくプログラムを組んだのですが、
新しいPDFが開けず、オートメーションエラーですと
でてきてしまいます。。。

どなたか、助けて下さい。
下記に作成したプログラムを記載いたします。

宜しくお願い致します。


  Sub insPDF_jp()

    Dim Ret As Integer
    Dim sFilePath As String
    Dim sFileCheck As String
    Dim rngFile As String
    Dim iRtn As Integer
    Dim GetNumPages As Long
    Dim Pages As Long
    Dim i As Integer

    Dim acroApp As CAcroApp
    Dim avDoc As CAcroAVDoc
    Dim AcroNew As CAcroPDDoc
    Dim AcroAdd As CAcroPDDoc

    Set AcroAdd = CreateObject("AcroExch.PDDoc")
    Set avDoc = CreateObject("AcroExch.AVDoc")
    Set AcroNew = CreateObject("AcroExch.PDDoc")
    Set acroApp = CreateObject("AcroExch.APP")

    Sheets("Sheet1").Select

    Pages = 0

    Ret = AcroNew.Create()

    For i = 223 To 246
      If ActiveSheet.Range("$CR$" & i) = "" Then
      Else
        rngFile = ActiveSheet.Range("$CZ$" & i).Text
        If Trim$(ActiveSheet.Range("$CR$" & i).Text) <> "" Then
          sFilePath = ActiveSheet.Range("$CR$" & i).Text & "\\" & rngFile
          sFileCheck = Dir$(sFilePath, 0)
          If sFileCheck <> "" Then
            Ret = AcroAdd.Open(sFilePath)
            GetNumPages = AcroAdd.GetNumPages()
            Ret = AcroNew.InsertPages(Pages - 1, AcroAdd, 0, GetNumPages, False)
            Ret = AcroAdd.Close()
            Pages = Pages + GetNumPages
          Else
            iRtn = MsgBox("ファイルが見つかりません。このまま継続しますか?", vbYesNo, "エラー")
            If iRtn = vbNo Then
              MsgBox ("処理を中断します。")
              Exit For
            End If
          End If
        End If
      End If
    Next
    Set avDoc = AcroNew.OpenAVDoc("New PDF")
    Set AcroAdd = Nothing
    Set AcroNew = Nothing
    Ret = acroApp.Show

  End Sub

2 hits

【67741】PDFの作成について 会社員 11/1/6(木) 11:50 質問

14487 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free