将表从pdf导入到Excel - 需要取消注释并注释一段代码才能运行

时间:2017-08-18 16:48:38

标签: excel vba excel-vba

我几乎想到了它并且它工作得很好,除了我在打开工作簿时遇到以下错误并且必须经历这个取消注释和评论一段代码的过程。

以下是代码:

Private Sub ActivateExcel()

AppActivate "Microsoft Excel"

    'Import_PDF receives the table from the PDF file.
    Sheets("ImportPDF").Select

    'clear all previous data (at the moment this causes an error so look for another way)
    ThisWorkbook.Sheets("ImportPDF").Cells.ClearContents

    Range("A1").Select
    ActiveSheet.Paste


 'IMPORTANT NOTE__________________________________________________________________
 '
 'The section which requires tinkering: this next code below will separate the pdf
 'table into excel columns, however it only needs to be done the first time, and then
 'just pasting works! doing this the 2nd time makes an error. 2nd run now only need to
 'sort a-z the new ImportPDF sheet (put 3.5 after 3 instead of at the end!

    Application.CutCopyMode = False
'     Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
'       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
'       Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
'       :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
'       Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
'       ), Array(14, 1)), TrailingMinusNumbers:=True


    ActiveWorkbook.Worksheets("ImportPDF").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ImportPDF").Sort.SortFields.Add Key:=Range("A3"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("ImportPDF").Sort
        .SetRange Range("A3:N26")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    'copy the column from Import_PDF "dev" to the volute sheet which was active on ctrl-b
    '
    Range("B3:B26").Select
    Selection.Copy
    'ActiveWindow.ScrollWorkbookTabs Position:=xlFirst

    'here select the target active sheet when ctrl-b started the macro:
    'whichever sheet is open during ctrl-b will get the PDF "dev" col now...
    'MsgBox ActiveSheet.Name & "  activating this sheet now..."
    Sheets(ActiveSheetImport).Select
    'ActiveWindow.SmallScroll Down:=24

  'need a time delay right here!
  'MsgBox "currently active = " & ActiveSheet.Name & "       active on ctrl-b was = " & ActiveSheetImport

    'and here we can paste to the active cell when ctrl-b started macro:
    'the range is the active cell! that's where the dev col pastes to next line:
    ActiveSheet.Paste


    Range("A1").Select
'Range("A1").Activate
'SendKeys ("^v")

'Shell "pskill " & StartAdobe
'Call Shell("TaskKill /F /PID " & CStr(vPID), vbHide)
End Sub

所以当我第一次运行宏来将数据导入" ImportPDF"工作表数据看起来像:[错误1] [1]

所以要解决这个问题:这部分代码是:

Application.CutCopyMode = False
     Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
       Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
       :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
       Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
       ), Array(14, 1)), TrailingMinusNumbers:=True

所以我会取消注释这行代码,然后重新运行宏。我必须运行两次宏。我第二次运行宏时出现此错误:Error 2

一旦我收到该错误,如果我再次评论该代码,并运行宏。数据传输非常完美,就像一个魅力。但是,如果我关闭工作簿,我必须重做整个过程。有谁知道那是为什么?或者我如何解决这个问题?

Error3

1 个答案:

答案 0 :(得分:0)

一旦您运行TextToColumns一次,Excel有时会记住"设置并自动将其应用于任何后续粘贴操作。

解决这个问题的一种方法可能是在粘贴后检查Selection.Columns.Count,然后仅在计数为1时将文本运行到列

Application.CutCopyMode = False
With Selection
    If .Columns.Count = 1 Then
        'EDITED
        .TextToColumns Destination:= .Cells(1).Offset(0,1), DataType:=xlDelimited, _
           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
           Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
            FieldInfo :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
            Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), _
            Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1)), TrailingMinusNumbers:=True
    End If
End With