私はExcelにPDFファイルを変換できるようにする必要がありませんインターネットとコンピュータを持っているアドビリーダー

Question

を使用してExcelにPDFファイルを変換し、私が持っているすべては、現在私が持っている、アドビリーダーは、アドビシステムズ社の専門家を得ることは不可能である

ですExcelを使用して、PDFファイル（または任意の他のOfficeアプリケーション）を開くための素晴らしい作品、このコード、：

Option Explicit 

Function OpenPDFPage(PDFPath As String, PageNumber As Long, PageView As Integer) 

    'Opens a pdf file, at specific page and with specific view. 
    'Sendkeys method is used for simulating keyboard shortcuts. 
    'It can be used with both Adobe Reader & Adobe Professional. 

    'By Christos Samaras 

    'This line depends on the apllication you are using. 
    'For Word 
    'ThisDocument.FollowHyperlink PDFPath, NewWindow:=True 
    'For Power Point 
    'ActivePresentation.FollowHyperlink PDFPath, NewWindow:=True 
    'For Excel 
    ThisWorkbook.FollowHyperlink PDFPath, NewWindow:=True 
    SendKeys ("^+N" & PageNumber & "~^" & PageView), True 

End Function 

Sub Test() 

    OpenPDFPage "file\path", 115, 2 'place file path here 

    'Page view options: 
    '0: Full Page 
    '1: Zoom to 100% 
    '2: Page Width 

End Sub 

私はVBAを使用して、私のワークシートにファイルの内容をコピーするにはどうすればよいですか？ これはかなり必要なものですが、pdfファイルのコンテンツを別の列に配置する方法は非常に高く評価されます。

Answer 1

は、いくつかの時間それを考え出すを持っていた私の最善を尽くし、誰もがキーイベントにに依存しない、より良い、より信頼性の高いコードを持っている場合は、plzは

Option Explicit 
Dim ShortFileName As String 
Dim myRange As Range 
Dim NumRows 
Dim strg As String 
Dim wb As Workbook 
Dim intChoice As Integer 
Dim Full_File_Path As String 
Dim i As Long 
Dim NumberOfPages As Long 
Dim Current_Page As Long 
Dim Current_Cell As Integer 
Dim StartingRow As Integer 
Dim WrdArray() As String 
Dim text_string As String 

#If VBA7 Then 

    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 

#Else 

    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 

#End If 

Declare Function FindWindow _ 
    Lib "user32" Alias "FindWindowA" (_ 
    ByVal lpClassName As String, _ 
    ByVal lpWindowName As String) As Long 

Declare Function PostMessage _ 
    Lib "user32" Alias "PostMessageA" (_ 
    ByVal hwnd As Long, _ 
    ByVal wMsg As Long, _ 
    ByVal wParam As Long, _ 
    ByVal lParam As Long) As Long 



Function OpenPDFPage(PDFPath As String, PageNumber As Long, PageView As Integer) 


    'Opens a pdf file, at specific page and with specific view. 
    'Sendkeys method is used for simulating keyboard shortcuts. 
    'It can be used with both Adobe Reader & Adobe Professional. 

    'By Christos Samaras 

    'This line depends on the apllication you are using. 
    'For Word 
    'ThisDocument.FollowHyperlink PDFPath, NewWindow:=True 
    'For Power Point 
    'ActivePresentation.FollowHyperlink PDFPath, NewWindow:=True 
    'For Excel 
    ThisWorkbook.FollowHyperlink PDFPath, NewWindow:=True 
    SendKeys ("^+N" & PageNumber & "~^" & PageView), True 


End Function 
Sub Test() 
Application.ScreenUpdating = False 
    Set wb = ActiveWorkbook 
    Set myRange = Range("B:B") ' change the address to whatever suits you 
    Application.FileDialog(msoFileDialogOpen).InitialFileName = Range("A1").Value 
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 

    intChoice = Application.FileDialog(msoFileDialogOpen).Show 
    'Select the start folder 
    'make the file dialog visible to the user 
    'determine what choice the user made 
    If intChoice <> 0 Then 
    'get the file path selected by the user 
    Full_File_Path = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 
    Range("A1").Value = Full_File_Path ' change the address to whatever suits you 
    NumberOfPages = GetPageNum(Full_File_Path) 
    ShortFileName = Dir(Full_File_Path) 
    For Current_Page = 1 To NumberOfPages 

    OpenPDFPage Full_File_Path, Current_Page, 1 
    'Page view options: 
    '0: Full Page 
    '1: Zoom to 100% 
    '2: Page Width 
    StartingRow = 1 + Application.WorksheetFunction.CountA(myRange) 

    For i = 1 To 11 
    Debug.Print Now() 
    Sleep 7 
    SendKeys "^a", True 
    SendKeys "^c", True 
    Next i 

    wb.ActiveSheet.Cells(StartingRow, 3).Value = Current_Page 
    For i = 1 To 11 
    Debug.Print Now() 
    Sleep 7 
    wb.ActiveSheet.Cells(StartingRow, 2).Select 
    On Error Resume Next 
    Selection.PasteSpecial 
    Next i 


    NumRows = 1 + Application.WorksheetFunction.CountA(myRange) 
    wb.ActiveSheet.Cells(NumRows, 2).Value = "." 



    If Current_Page = NumberOfPages Then 
    Call PostMessage(FindWindow(vbNullString, ShortFileName & " - Adobe Acrobat Reader DC"), 16, 0, 0) 
    End If 


    For Current_Cell = StartingRow To NumRows 
    text_string = Cells(Current_Cell, 2) 
    WrdArray() = Split(text_string) 
    For i = LBound(WrdArray) To UBound(WrdArray) 
    strg = strg & vbNewLine & "Part No. " & i & " - " & WrdArray(i) 
    Cells(Current_Cell, 50 - i) = WrdArray(i) 
    strg = 0 
    text_string = 0 
    Next i 
    Next Current_Cell 

    Next Current_Page 

End If 
Application.ScreenUpdating = True 
Exit Sub 

End Sub 


Function GetPageNum(PDF_File As String) 
    'Haluk 19/10/2008 
    Dim FileNum As Long 
    Dim strRetVal As String 
    Dim RegExp 
    Set RegExp = CreateObject("VBscript.RegExp") 
    RegExp.Global = True 
    RegExp.Pattern = "/Type\s*/Page[^s]" 
    FileNum = FreeFile 
    Open PDF_File For Binary As #FileNum 
     strRetVal = Space(LOF(FileNum)) 
     Get #FileNum, , strRetVal 
    Close #FileNum 
    GetPageNum = RegExp.Execute(strRetVal).Count 
End Function 

を共有します