埋め込みPDFをWordファイルに保存

Question

埋め込みPDF添付ファイルをWordファイルに保存するには、MS Word 2013用のVBAマクロが必要です。

私は、Excel文書に埋め込まれたファイルを保存し、Excelで作業ソリューションは、私は、Word VBAで動作するようにいくつかの変更を行っているが、それはそれはWordで動作させるために任意のアイデアは動作しません？い

Private Declare PtrSafe Function CloseClipboard Lib "user32"() As Long 
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long 
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long 
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long 
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long 
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long 
Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long) 

Sub Embed_Files_Save_PDF_Run() 
For Each file In ThisDocument.InlineShapes 
Call Embed_Files_Save_PDF(file) 
Next 
End Sub 

Sub Embed_Files_Save_PDF(ByVal Embedded_PDF) 

     On Error Resume Next 

     Dim PDF_Path As String 
     PDF_Path = ActiveDocument.Path 

     If Right$(PDF_Path, 1) <> Application.PathSeparator Then PDF_Path = PDF_Path & Application.PathSeparator 

     Dim PDF_Name As String 
     PDF_Name = UCase$(Left$(Embedded_PDF.OLEFormat.IconLabel, 1)) & Mid$(Embedded_PDF.OLEFormat.IconLabel, 2)  
     PDF_Name = PDF_Name & ".PDF" 

     Dim FileEOF As Long 
     Dim FileLOF As Long 
     Dim CB_Lock As Long   ' ClipBoard Lock 
     Dim CB_Size As Long   ' ClibBoard Size 
     Dim PDF_File() As Byte 
     Dim Temp_PDF() As Byte 

     Embedded_PDF.Copy 
     If OpenClipboard(0) Then 
      Counter = GetClipboardData(49156) 
      If Counter <> 0 Then CB_Size = GlobalSize(Counter) 
      If CB_Size <> 0 Then CB_Lock = GlobalLock(Counter) 
      If CB_Lock <> 0 Then 
        ReDim Temp_PDF(1 To CLng(CB_Size)) 
        RtlMoveMemory Temp_PDF(1), ByVal CB_Lock, CB_Size 
        Call GlobalUnlock(Counter) 
        Counter = InStrB(Temp_PDF, StrConv("%PDF", vbFromUnicode)) 
        If Counter > 0 Then 
         FileEOF = InStrB(Counter, Temp_PDF, StrConv("%%EOF", vbFromUnicode)) 
         While FileEOF 
           FileLOF = FileEOF - Counter + 7 
           FileEOF = InStrB(FileEOF + 5, Temp_PDF, StrConv("%%EOF", vbFromUnicode)) 
         Wend 

         ReDim PDF_File(1 To FileLOF) 
         For FileEOF = 1 To FileLOF 
           PDF_File(FileEOF) = Temp_PDF(Counter + FileEOF - 1) 
         Next 
        End If 
      End If 
      CloseClipboard 
      If Counter > 0 Then 
        Counter = FreeFile 
        Open PDF_Path & PDF_Name For Binary As #Counter 
         Put #Counter, 1, PDF_File 
        Close #Counter 
      End If 
     End If 

     Set Embedded_PDF = Nothing 

End Sub 

助けてください。

Answer 1

それはpdfファイルを保存するものではありませんが、それを

Sub pdfExtract() 

    ' opens embedded pdf file in acrobat reader for saving 

    Dim shap As InlineShape 

    For Each shap In ActiveDocument.InlineShapes 
     If Not shap.OLEFormat Is Nothing Then 
      If shap.OLEFormat.ClassType = "AcroExch.Document.DC" Then 
       shap.OLEFormat.DoVerb wdOLEVerbOpen 
      End If 
     End If 
    Next shap 
End Sub