aprire file pdf, copiare contenuto e incollare il testo in excel

Question

ciao a tutti,

ho creato una macro per copiare il contenuto di un file pdf e incollarlo in un figlio di excel

in realtà la macro non è farina del mio sacco, ma un copia incolla di esperti,

purtroppo devo aver commesso qualche errore

chi riesce a darmi una mano nella correzione ? grazie

mauro

Sub SelezionaPdf()

    Dim myReturn As Double

    Dim sPath, filepdf, filepdf2, cartella, mypath, mycomand As String

    Dim CR, istruz As String

    Dim lRiga, lCol, lng, lUltRiga As Long

    Dim task

    'dichiaro le variabili oggetto di tipo Worksheet e Workbook

    Dim sh As Worksheet

    Dim wk As Workbook

    Dim PageName, PageName2 As String

    CR = "CR3"

    istruz = "istruzioni3"

    Sheets(CR).Select

    cartella = ActiveWorkbook.Name

    Set wk = ThisWorkbook

    Set sh = wk.Worksheets(CR)

     ' these lines look for a pdf file in your My Documents folder

    Set WshShell = CreateObject("WScript.Shell")

    'ChDir (WshShell.SpecialFolders("V:"))

    PageName = Application.GetOpenFilename("YourPage, *.pdf", , "YourPage")

     ' if no file is picked the macro ends

    If PageName = "False" Then

        Exit Sub

    End If

    Sheets(istruz).Range("I1").Value = PageName

    Sheets(CR).Select

    Sheets(CR).Range("A:K").ClearContents

    Range("A1").Select

    PageName2 = "C:\temp\YourPage.pdf"

    FileCopy PageName, PageName2

    mycomand = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe C:\temp\YourPage.pdf"

    task = Shell(mycomand, 1)

    Application.Wait (Now + TimeValue("0:00:04"))

    SendKeys "^a", True

    Application.Wait (Now + TimeValue("0:00:02"))

    SendKeys "^c", True

    Application.Wait (Now + TimeValue("0:00:05"))

    'SendKeys ("%fx")

    AppActivate "Microsoft Excel"

    wk.Activate

    sh.Activate

    ' qui sbaglia !!!!!!!!!!!!!!!!!!!!!!!

    Sheets(CR).Select

    Range("A1").Select

    MsgBox "Premi Ok per incollare"

    Sheets(CR).Select

    Range("A1").Select

    SendKeys ("^v")

    ' se togli questa riga, incolla sul foglio sbagliato

    MsgBox "Premi Ok quando incollato"

    Sheets(istruz).Select

    Range("A1").Select

     'Set a Nothing delle variabili oggetto

    Set sh = Nothing

    Set wk = Nothing

End Sub

Answer 1

Ciao Mauro,

Avendo dichiarato la variable sh, sarebbe meglio sarebbe usarla!

'=========>>

Option Explicit

'--------->>

Private Declare Function FindExecutable _

    Lib "shell32.dll" Alias "FindExecutableA" ( _

    ByVal lpFile As String, ByVal lpDirectory As String, _

    ByVal lpResult As String) As Long

'--------->>

Public Sub SelezionaPdf()

    Dim wk As Workbook

    Dim sh As Worksheet

    Dim PageName As Variant, PageName2 As String

    Const CR As String = "CR3"

    Const istruz As String = "istruzioni3"

    Set wk = ThisWorkbook

    Set sh = wk.Worksheets(CR)

    PageName = Application _

               .GetOpenFilename("Text Files (*.pdf), *.pdf")

    If PageName <> False Then

        MsgBox "Open " & PageName

    End If

    If PageName = "False" Then

        Exit Sub

    End If

    Sheets(istruz).Range("I1").Value = PageName

With sh

.Select

.Range("A:K").ClearContents

.Range("A1").Select

End With

    PageName2 = "C:\temp\YourPage.pdf"

    FileCopy PageName, PageName2

    Call OpenPDF(PageName2)

    Application.Wait (Now + TimeValue("0:00:04"))

    SendKeys "^a", True

    Application.Wait (Now + TimeValue("0:00:02"))

    SendKeys "^c", True

    Application.Wait (Now + TimeValue("0:00:05"))

    SendKeys ("%fx")

    AppActivate "Microsoft Excel"

    wk.Activate

    sh.Activate

    MsgBox "Premi Ok per incollare"

    '\ Nuova istruzione

DoEvents

    SendKeys ("^v")

    '\ Nuova istruzione

DoEvents

    Sheets(istruz).Select

    Range("A1").Select

    'Set a Nothing delle variabili oggetto

    Set sh = Nothing

    Set wk = Nothing

End Sub

'--------->>

Sub OpenPDF(filename As String)

    Dim ExeName As String

    Dim N As Long

        ExeName = String(260, 0)

    N = FindExecutable(filename, vbNullString, ExeName)

    ExeName = Left(ExeName, InStr(1, ExeName, vbNullChar) - 1)

    Shell ExeName & " " & Chr(34) & filename & Chr(34), vbNormalFocus

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Ciao Mauro,

Prova la seguente versione del codice:

'=========>>

Option Explicit

'--------->>

Private Declare Function FindExecutable _

    Lib "shell32.dll" Alias "FindExecutableA" ( _

    ByVal lpFile As String, ByVal lpDirectory As String, _

    ByVal lpResult As String) As Long

'--------->>

Public Sub SelezionaPdf()

    Dim wk As Workbook

    Dim sh As Worksheet

    Dim PageName As Variant, PageName2 As String

    Dim Cartella As String

    Const CR As String = "CR3"

    Const istruz As String = "istruzioni3"

    Sheets(CR).Select

    Cartella = ActiveWorkbook.Name

    Set wk = ThisWorkbook

    Set sh = wk.Worksheets(CR)

    PageName = Application _

               .GetOpenFilename("Text Files (*.pdf), *.pdf")

    If PageName <> False Then

        MsgBox "Open " & PageName

    End If

    If PageName = "False" Then

        Exit Sub

    End If

    Sheets(istruz).Range("I1").Value = PageName

    Sheets(CR).Select

    Sheets(CR).Range("A:K").ClearContents

    Range("A1").Select

    PageName2 = "C:\temp\YourPage.pdf"

    FileCopy PageName, PageName2

    Call OpenPDF(PageName2)

    Application.Wait (Now + TimeValue("0:00:04"))

    SendKeys "^a", True

    Application.Wait (Now + TimeValue("0:00:02"))

    SendKeys "^c", True

    Application.Wait (Now + TimeValue("0:00:05"))

    SendKeys ("%fx")

    AppActivate "Microsoft Excel"

    wk.Activate

    sh.Activate

    MsgBox "Premi Ok per incollare"

'\ Nuova istruzione

DoEvents

    SendKeys ("^v")

'\ Nuova istruzione

DoEvents

    Sheets(istruz).Select

    Range("A1").Select

    'Set a Nothing delle variabili oggetto

    Set sh = Nothing

    Set wk = Nothing

End Sub

'--------->>

Sub OpenPDF(filename As String)

    Dim ExeName As String

    Dim N As Long

        ExeName = String(260, 0)

    N = FindExecutable(filename, vbNullString, ExeName)

    ExeName = Left(ExeName, InStr(1, ExeName, vbNullChar) - 1)

    Shell ExeName & " " & Chr(34) & filename & Chr(34), vbNormalFocus

End Sub

'<<=========

Per quanto riguarda il tuo codice, ti farei notare che credo sia consigliabile sempre dichiarare il tipo di tutte le variabili esplicitamente. Per dimostrare il ragionamento di questo consiglio, considera le tue dichiarazioni originali:

    Dim sPath, filepdf, filepdf2, cartella, mypath, mycomand As String

    Dim CR, istruz As String

    Dim lRiga, lCol, lng, lUltRiga As Long

Queste dichiarazioni sarebbero interpretate da VBA come:

    Dim sPath As Variant

    Dim filepdf As Variant, filepdf2 As Variant

    Dim cartella As Variant, mypath As Variant

    Dim mycomand As String

    Dim CR As Variant, istruz As String

    Dim lRiga As Variant, lCol As Variant, lng As Variant, lUltRiga   As Long

mentre la tua intenzione era probabilmente:

    Dim sPath As String

    Dim filepdf As String, filepdf2 As String

    Dim cartella As String, mypath As String

    Dim mycomand As String

    Dim CR As String, istruz As String

    Dim lRiga As Long, lCol As Long, lng As Long, lUltRiga   As Long

===

Regards,

Norman

Answer 3

Ciao Mauro,

Ti ringrazio per il riscontro.

Per favore,  potresti contrassegnare la risposta rilevante come Risposta per chiudere il thread?

===

Regards,

Norman