Question

我正在尝试将数据从PDF导出到Excel，我可以导出数据但不能按顺序导出。下面是输入和输出

PDF文件

实际输出我

预期输出 - 按顺序期待

    'Location of 'Adobe Acrobat Reader' (only used, if it is not the default PDF reader)
Private Const AdobePDFReader As String = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"

' Public variable to test, if we were successful in copying from PDF document to Excel worksheet
Public PDF2XL_Success  As Boolean

' API Functions
#If VBA7 = False Then
   Private Declare Function FindExecutable Lib "shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
   Private Declare Function DownloadURLToFile Lib "URLMon.DLL" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
   Private Declare PtrSafe Function FindExecutable Lib "shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
   Private Declare PtrSafe Function DownloadURLToFile Lib "URLMon.DLL" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If

Option Explicit

Sub PDF2XL_Test()

' * ' Initialize
   On Error Resume Next


' * ' Define variable
   Dim PDFFile As String

   PDFFile = "C:\Users\AntoDesktop\PA\PA Doc 1 Remedy.pdf"


' * ' Copy PDF contents to active Excel worksheet
   Call PDF2XL(PDFFile)


' * ' Here you can adjust the copied contents
   If PDF2XL_Success = True Then Application.Run "PDF2XL_Adjust"


ES:  ' End of Sub
   Range("A1").Select

End Sub
Sub PDF2XL(Optional ByVal PDFFile As String = vbNullString, Optional ByVal DestinationWorksheet As Excel.Worksheet)

    ' * ' Initialize
   On Error Resume Next


' * ' Define variables
   PDF2XL_Success = False

   If TypeName(DestinationWorksheet) <> "Worksheet" Then Set DestinationWorksheet = ActiveSheet


   If Len(PDFFile) < xlLess Or Len(Dir(PDFFile, vbHidden + vbSystem)) < 3 Then   ' If no PDF document is given, then ask for one
         PDFFile = Application.GetOpenFilename("PDF (*.PDF), *.PDF")
         If Len(PDFFile) < xlLess Then GoTo ES:                                  ' User clicked [Cancel]
   End If

   Dim FileAddressBuffer As String
   FileAddressBuffer = Space$(260)

   Dim FileHandle As Long
   FileHandle = FindExecutable(Mid$(PDFFile, InStrRev(PDFFile, Application.PathSeparator) + 1), Left$(PDFFile, InStrRev(PDFFile, Application.PathSeparator)), FileAddressBuffer)

   Dim PDFReader As String
   If FileHandle >= 32 Then                                                       ' System has a PDF application installed
         FileHandle = InStr(FileAddressBuffer, Chr$(0))
         PDFReader = Left$(FileAddressBuffer, FileHandle - 1)                    ' Default PDF application of system
   Else                                                                          ' System does not have a PDF application installed
         Select Case Application.LanguageSettings.LanguageID(2)                  ' Insert your own language below, if you want to
               Case 1030, 1080:  MsgBox "Could not locate PDF Reader on computer.", vbOKOnly + vbCritical, " PDF Reader"
               Case Else:        MsgBox "Could not locate PDF Reader on computer.", vbOKOnly + vbCritical, " PDF Reader"
         End Select
         GoTo ES:
   End If

   FileHandle = InStrRev(UCase$(PDFReader), "ADOBE")
   If FileHandle > 0 Then
         FileHandle = InStrRev(UCase$(PDFReader), "READER")
   End If
   If FileHandle < 1 Then                                                        ' The default PDF application is not 'Adobe PDF Reader'
         If Len(Dir(AdobePDFReader)) < 5 Then                                    ' The given PDF Reader in the constant in the declaration field can not be found
               Select Case Application.LanguageSettings.LanguageID(2)            ' Insert your own language below, if you want to
                     Case 1030, 1080:  FileHandle = MsgBox("Den fundne PDF læser..." & vbNewLine & vbNewLine & PDFReader & vbNewLine & vbNewLine & "...ser ikke ud til at være 'Adobe Acrobat Reader'." & vbNewLine & vbNewLine & "Forsætte?", vbYesNo + vbExclamation, " PDF Reader")
                     Case Else:        FileHandle = MsgBox("The found PDF reader..." & vbNewLine & vbNewLine & PDFReader & vbNewLine & vbNewLine & "...doesn't seems to be 'Adobe Acrobat Reader'." & vbNewLine & vbNewLine & "Continue?", vbYesNo + vbExclamation, " PDF Reader")
               End Select
               If FileHandle = vbNo Then GoTo ES:
         Else
               PDFReader = AdobePDFReader
         End If
   End If
   PDFReader = Chr(34) & PDFReader & Chr(34) & " " & Chr(34) & Replace(PDFFile, Chr(34), vbNullString) & Chr(34)




' * ' Prepare worksheet
   DestinationWorksheet.DisplayPageBreaks = False

   DestinationWorksheet.Unprotect
   If DestinationWorksheet.ProtectContents = True Then GoTo ES:

   DestinationWorksheet.Visible = xlSheetVisible
   If DestinationWorksheet.Visible <> xlSheetVisible Then GoTo ES:

   DestinationWorksheet.Select
   DestinationWorksheet.Cells.Delete

   Range("A1").Select


' * ' Transfer PDF contents to Excel
   Application.CutCopyMode = False                                                ' Clear/reset Cut/Copy mode

   Shell PDFReader, vbNormalFocus                                                ' Open PDF document

   Application.Wait Now + TimeValue("00:00:03")                                  ' Wait a little to give document time to fully open
   DoEvents

   SendKeys "^a"                                                                 ' Select all in PDF document
   SendKeys "^c"                                                                 ' Copy selected contents

   Application.Wait Now + TimeValue("00:00:02")                                  ' Wait a little to give clipboard time to copy (if huge contents)
   DoEvents

   SendKeys "^q"                                                                 ' Close PDF document

   Application.Wait Now + TimeValue("00:00:01")                                  ' Wait a little to give document time to close completely
   Application.Run "ActivateExcel", True                                         ' Re-activate Excel in case another application was activate when closing PDF Reader
   DoEvents

   Err.Clear
   DestinationWorksheet.Paste                                                    ' Paste PDF contents into worksheet
   If Err.Number = 0 Then PDF2XL_Success = True


ES:  ' End of Sub
   Application.CutCopyMode = False                                                ' Clear/reset Cut/Copy mode

   Range("A1").Select

   Set DestinationWorksheet = Nothing
   'If TempFile <> vbNullString Then Kill TempFile

End Sub

Answer 1

获得实际输出后，您可以将文本拆分为列，然后进行转置。

Public Sub SplitAndTranspose()
    Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
        TrailingMinusNumbers:=True
    Range("A1", Range("A1").End(xlToRight)).Copy
    Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Rows(1).Delete Shift:=xlUp
    Application.CutCopyMode = False
End Sub

无法使用VBA

1 个答案: