[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

D
  • Question
XL 2019 Message diffèrent en fonction état booléens
Réponses
3
Affichages
504
darkjedi
D
chris6999
  • Question
Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne
Réponses
5
Affichages
334
patricktoulon
patricktoulon
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
415
job75
job75
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
297
Gégé-45550
Gégé-45550
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
216
Phil69970
Phil69970
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
329
Chaton77
Chaton77
PORCHER
  • Question
Microsoft 365 Incompatibilité de type
Réponses
1
Affichages
233
Dranreb
Dranreb
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
413
GClaire
G
U
  • Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
284
Phil69970
Phil69970
AlCapone
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
108
AlCapone
AlCapone

Membres actuellement en ligne

13 membres et 288 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
314 490
Messages
2 110 139
Membres
110 684
dernier inscrit
kihel