[Résolu]Problème de changement de fenêtre (PDF / EXCEL)

Z

ZiM

XLDnaute Nouveau
Bonjour, je viens vers vous car je suis une fois de plus dans l'impasse !

Je vais essayer d'être le plus claire car comme vous allez le voir, ma macro commence a être longue ^^

En gros la procédure :
-ouvrir un PDF
-Copier les données
-Revenir sous excel
-Copier les données
-Retirer les espaces
-(revalider les données pour avoir des date avec un nombre valide et pas 01/12/10 valeur renvoyer 0 !)
-Convertir les données (en 10 colonnes)
-Changer de feuille

le problème réside lors du changement de feuille lors-que les données sont copier ! Le logiciel ne switch pas bien de la fenêtre PDF a Excel. (je n'ai pas besoin de conserver le PDF ouvert.)

Précisions : Excel 2007 win XP

Mon code est surement a simplifier le voici :


Code: 
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub OpenPDF(ByRef vsFilePath As String, Optional ByVal vnPage As Long = 1)
Dim sBuffer As String
Dim nLength As Long
    sBuffer = Space$(260)
    nLength = FindExecutable(vsFilePath, vbNullString, sBuffer)
    If nLength Then
        nLength = InStr(sBuffer, vbNullChar)
        If nLength Then
            sBuffer = Left$(sBuffer, nLength - 1)
            ShellExecute 0&, "open", sBuffer, "/A page=" & Trim$(Str$(vnPage)) & " """ & vsFilePath & """", vbNullString, 1
        End If
    End If

End Sub
Sub convert()

' Ouvre le PDF, copie et inserre les données
    
    OpenPDF "C:\Documents and Settings\Utilisateur\Bureau\SYNel.pdf", 1
    Application.Wait (Now + TimeValue("0:00:02"))
    SendKeys ("^{a}")
    Application.Wait (Now + TimeValue("0:00:01"))
    SendKeys ("^{c}")
    Application.Wait (Now + TimeValue("0:00:02"))
    Windows("Anicompta.xlsm").Activate
    Application.Wait (Now + TimeValue("0:00:01"))
    
    ' annulation convert

    Range("A1").Select
    ActiveCell.FormulaR1C1 = "1 2 3"
    
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    
    Range("A1:C1").ClearContents
    
    Range("A1").Select
    Application.Wait (Now + TimeValue("0:00:02"))
    ActiveSheet.PasteSpecial Format:="Texte Unicode", Link:=False, _
    DisplayAsIcon:=False
    Application.Wait (Now + TimeValue("0:00:05"))
    
MsgBox "Cliquez afin de passer à l'étape 2"

 ' couper les blanc des noms
 
Dim mm, Résultat As String, i As Double, K As Double
K = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To K
    If Left(Range("A" & i), 2) = "FR" Then
        With CreateObject("vbscript.regexp")
            .Global = False: .IgnoreCase = True: .Pattern = " \d{3,4} [-A-Za-z _]* \d\d/\d\d/\d{4} "
            Set mm = .Execute(Range("A" & i))
            If mm.Count = 0 Then
                Range("A" & i) = Left(Range("A" & i), 19) & "_" & Right(Range("A" & i), Len(Range("A" & i)) - 18)
            Else
                If Len(mm(0)) = 18 Then
                    Range("A" & i) = Replace(Range("A" & i), "  ", " _ ")
                Else
                    Résultat = Mid(mm(0), 7, Len(mm(0)) - 6 - 12)
                    Range("A" & i) = Replace(Range("A" & i), Résultat, Replace(Résultat, " ", "_"))
                End If
            End If
        End With
    End If
Next i


' enregconvertir en colonnes

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

    Sheets("Données Anicompta").Select

Dim Plage As Range, Cel As Range
  Set Plage = Range("E1:K2000")
  'tu peux écrire :
  'Set Plage = Range("A1:A983") ou tout autre plage que tu veux modifier
  For Each Cel In Plage
    If IsNumeric(Cel.Value) Then Cel.Value = CDbl(Cel.Value)
  Next Cel
  
  
' test si des erreures sont présentes

If Range("N1").Value > 0 Then
MsgBox "Une erreure est présente merci de vériffier les données"
Else: Range("N1").Value = 0
MsgBox "Les données sont valides pour Anicompta"
End If
End Sub

A votre disposition si vous avez besoin de renseignements !

Gros merci d'avance pour l'investissement de mon problème !
 
Dernière édition:
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re : Problème de changement de fenêtre (PDF / EXCEL)

Bonjour Zim

Pour info,
code récupéré un jour, qui permet de copier/coller du texte d'un fichier PDF

Il faut avoir coché dans les références : Adobe Acrobat
VB: 
Sub RecupTextPDF()
  Dim PDDoc As Acrobat.AcroPDDoc
  Dim PDPage As Acrobat.AcroPDPage
  Dim PDText As Acrobat.AcroPDTextSelect
  Dim TextSelt As Acrobat.AcroHiliteList
  Dim R1 As Long
  Dim i As Long
  Dim j As Long
  Dim wkPage As Long
  Dim wkCnt As Long
  Dim wkText As String
  Dim FName As String
  Dim oDO As MSForms.DataObject
  
  FName = "D:\Mes Documents\MonFichier.pdf"
  Set PDDoc = CreateObject("AcroExch.PDDoc")
  R1 = PDDoc.Open(FName)
  Set TextSelt = CreateObject("AcroExCh.HiliteList")
  TextSelt.Add 0, 32767
  wkPage = PDDoc.GetNumPages()
  For i = 0 To wkPage - 1
    Set PDPage = PDDoc.AcquirePage(i)
    Set PDText = PDPage.CreatePageHilite(TextSelt)
    wkCnt = PDText.GetNumText()
    For j = 0 To wkCnt - 1
      wkText = wkText & PDText.GetText(j)
    Next j
  Next i
  PDDoc.Close
  
  Set oDO = New MSForms.DataObject
  oDO.Clear
  oDO.SetText wkText
  oDO.PutInClipboard
  Worksheets(1).Range("A1").PasteSpecial
End Sub[/COLOR]

A+
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Z

ZiM

XLDnaute Nouveau
Re : Problème de changement de fenêtre (PDF / EXCEL)

C'est bon code réparé je copie mon code il est expliquer au mieux de mes maigres compétences si quelqu'un a besoin de piocher !

Deux parties car sinon elles ne s'exécutes pas à la suite !


Code: 
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub Extractionpdf()

    ' retirer convertion
        
    Sheets("Données PDF").Range("A1").Select
    ActiveCell.FormulaR1C1 = "1 2 3"
    
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
       
    Range("A1:C1").ClearContents

    URL = "C:\Documents and Settings\Utilisateur\Bureau\SYNel.pdf" 'Adapter à votre fichier
        'Ouvrir le fichier pdf avec le programme approprié
    ShellExecute 0&, vbNullString, URL, vbNullString, _
    vbNullString, vbNormalFocus

        'Attendre 2 secondes
    Application.Wait (Now + TimeValue("0:00:02"))

    NomDeLafenetre = "SYNel.pdf - Adobe Reader"
    AppActivate NomDeLafenetre 'Donner le focus à Acrobat Reader
    SendKeys "^{a}" 'Sélectionner tout avec CTRL-A
    AppActivate NomDeLafenetre
    SendKeys "^{c}" 'Copier avec CTRL-C

        'Attendre 2 secondes
    Application.Wait (Now + TimeValue("0:00:02"))

    AppActivate "Microsoft Excel" 'Redonner le focus à Excel

 


    ' Copie des données
 
    Sheets("Données PDF").Select
    Sheets("Données PDF").Range("A1").Select
    ActiveSheet.Paste
    
End Sub


Code: 
Sub etapedeux()
MsgBox "Cliquez afin de passer à l'étape 2"

 ' couper les blanc des noms
 
Dim mm, Résultat As String, i As Double, K As Double
K = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To K
    If Left(Range("A" & i), 2) = "FR" Then
        With CreateObject("vbscript.regexp")
            .Global = False: .IgnoreCase = True: .Pattern = " \d{3,4} [-A-Za-z _]* \d\d/\d\d/\d{4} "
            Set mm = .Execute(Range("A" & i))
            If mm.Count = 0 Then
                Range("A" & i) = Left(Range("A" & i), 19) & "_" & Right(Range("A" & i), Len(Range("A" & i)) - 18)
            Else
                If Len(mm(0)) = 18 Then
                    Range("A" & i) = Replace(Range("A" & i), "  ", " _ ")
                Else
                    Résultat = Mid(mm(0), 7, Len(mm(0)) - 6 - 12)
                    Range("A" & i) = Replace(Range("A" & i), Résultat, Replace(Résultat, " ", "_"))
                End If
            End If
        End With
    End If
Next i


' enregconvertir en colonnes

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

    Dim Plage As Range, Cel As Range
  Set Plage = Range("E1:K2000")
  'tu peux écrire :
  'Set Plage = Range("A1:A983") ou tout autre plage que tu veux modifier
  For Each Cel In Plage
    If IsNumeric(Cel.Value) Then Cel.Value = CDbl(Cel.Value)
  Next Cel
    
    Sheets("Données Anicompta").Select

' test si des erreures sont présentes

If Range("N1").Value > 0 Then
MsgBox "Une erreure est présente merci de vériffier les données"
Else: Range("N1").Value = 0
MsgBox "Les données sont valides pour Anicompta"
End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re : [Résolu]Problème de changement de fenêtre (PDF / EXCEL)

Salut Zim

Je vois avec "ravissement" ques les codes que l'on te donne te servent :rolleyes:

Vive les SENDKEYS et leurs erreurs

Rappel moi de ne pas t'aider la prochaine fois ...
 
Vote positif 0 Vote négatif

Discussions similaires

halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
197
halecs93
halecs93
E
  • Question
XL 2010 problème macro qui désactive le pavé numérique
2
Réponses
18
Affichages
578
Dranreb
Dranreb
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
525
halecs93
halecs93
S
  • Résolu(e)
XL 2016 problème de filtre dans listbox
2 3 4
Réponses
51
Affichages
1 K
saidoush
S
patricktoulon
  • Résolu(e)
XL 2013 prise de tête avec une variable static
Réponses
3
Affichages
219
patricktoulon
patricktoulon
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
213
guiyom
G
M
  • Question
XL 2016 Impression d'un rapport PDF depuis une URL avec VBA
Réponses
3
Affichages
521
mrcooll
M
N
  • Résolu(e)
Microsoft 365 Ajouter une condition dans une VBA
Réponses
2
Affichages
191
Nathan027
N
A
  • Résolu(e)
Microsoft 365 With Selection.Parent.MailEnvelope.Item
Réponses
13
Affichages
493
patricktoulon
patricktoulon
T
  • Résolu(e)
XL 2019 VBA - Comparaison d'heures
Réponses
9
Affichages
228
ThierryP
T

Membres actuellement en ligne

22 membres et 369 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 081
Messages
2 085 160
Membres
102 800
dernier inscrit
NOTZ