Erreur n°5 : Arugement ou appel de procédure incorrect

manu cho

XLDnaute Nouveau
Bonjour à tous!

*Attention Erreur, il ne s'agit pas de l'erreur n°9 mais n°5 ... sorry*

Un macro très intéressante permettant de fouiller un PDF me renvoit l'erreur n°5 : Arugement ou appel de procédure incorrect.

Vous trouverez ci-dessous le code qui permet d'extraire/importer les données depuis le PDF.

Merci beaucoup pour votre aide ;)



Private Sub Extraction()
Dim MaPlage As Range
Dim Macellule As Range
Dim DateActivation As Date
Dim VAL01 As String
Dim PremiereAdresse As String
Dim i As Long
On Error GoTo Erreur

ActiveSheet.Range("1:6").EntireColumn.NumberFormat = "@"
ActiveSheet.Columns(7).EntireColumn.NumberFormat = "m/d/yyyy"
i = 1
Set MaPlage = Worksheets("Feuil2").UsedRange
DateActivation = ExtraireDATE(MaPlage.Find("EDITE LE").Value)
VAL01 = ExtraireVAL01(MaPlage.Find("point :").Value)
With MaPlage

Set Macellule = .Find(What:="appel :", After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

Cells(i, 2) = "VAL00"
Cells(i, 3) = "VAL02"
Cells(i, 4) = "VAL03"
Cells(i, 5) = "VAL04"
Cells(i, 6) = "VAL05"
Cells(i, 7) = "Date Activation"
Cells(i, 8) = "VAL06"
Cells(i, 9) = "VAL07"
Cells(i, 10) = "VAL01"
Cells(i, 11) = "VAL08"

If Not Macellule Is Nothing Then
PremiereAdresse = Macellule.Address
Do
i = i + 1
Cells(i, 2) = ExtraireVAL00(Macellule.Value)
Cells(i, 3) = ExtraireVAL02(Macellule.Offset(7).Value)
Cells(i, 4) = ExtraireVAL03(Macellule.Offset(4).Value)
Cells(i, 5) = ExtraireVAL04(Macellule.Offset(5).Value)
Cells(i, 6) = ExtraireVAL05(Macellule.Offset(6).Value)
Cells(i, 7) = DateActivation
Cells(i, 8) = ExtraireVAL06(Macellule.Value)
Cells(i, 9) = ExtraireVAL07(Macellule.Offset(1).Value)
Cells(i, 10) = VAL01
Cells(i, 11) = ExtraireVAL08(Macellule.Offset(7).Value)

Set Macellule = .FindNext(Macellule)
Loop While Not Macellule Is Nothing And Macellule.Address <> PremiereAdresse
End If

End With
'Nettoyage

Range("A1").EntireColumn.Delete
Set MaPlage = Range("A1").CurrentRegion
MaPlage.Sort "VAL00", , , , , , , xlYes
For Each Macellule In MaPlage.Columns(1).Cells

With Macellule
If .Value = .Offset(1).Value Then

.Offset(1).EntireRow.Delete
.Offset(1).EntireRow.Delete

End If
End With

Next
Range("A1").Select
ActiveSheet.Columns.AutoFit
ActiveWorkbook.Save
Exit Sub
Erreur:

MsgBox Err.Description, vbCritical, "Erreur n° " & Err.Number, Err.HelpFile, Err.HelpContext

End Sub
Function ExtraireDATE(chaine As String) As Date

Dim Jour As String
Dim Mois As String
Dim An As String
Jour = Mid(chaine, InStr(chaine, "/") - 2, 2)
Mois = Mid(chaine, InStr(chaine, "/") + 1, 2)
An = Mid(chaine, InStr(chaine, "/") + 4, 4)
ExtraireDATE = CDate(Jour & "/" & Mois & "/" & An)

End Function
Function ExtraireVAL01(chaine As String) As String

ExtraireVAL01 = Mid(chaine, InStr(chaine, "Liste") + 24, 9)

End Function
Function ExtraireVAL00(chaine As String) As String
Dim temp
temp = Mid(chaine, InStr(chaine, "appel") + 6, 14)
ExtraireVAL00 = Replace(temp, ".", "")
End Function
Function ExtraireVAL06(chaine As String) As String

ExtraireVAL06 = Mid(chaine, InStr(chaine, "VAL06") + 10, 9)

End Function

Function ExtraireVAL02(chaine As String) As String
Dim temp
temp = Mid(chaine, InStr(chaine, "VAL02") + 7, 14)
ExtraireVAL02 = Replace(temp, ".", "")

End Function
Function ExtraireVAL04(chaine As String) As String

ExtraireVAL04 = Mid(chaine, InStr(chaine, "VAL04") + 6, 20)

End Function
Function ExtraireVAL03(chaine As String) As String

ExtraireVAL03 = Mid(chaine, InStr(chaine, "VAL03") + 7, 15)

End Function
Function ExtraireVAL05(chaine As String) As String

ExtraireVAL05 = Mid(chaine, InStr(chaine, "VAL05") + 8, 4)

End Function
Function ExtraireVAL07(chaine As String) As String

ExtraireVAL07 = Mid(chaine, InStr(chaine, "VAL07") + 14, 30)

End Function
Function ExtraireVAL08(chaine As String) As String

ExtraireVAL08 = Mid(chaine, InStr(chaine, "VAL08") + 11, 70)

End Function

Sub ImportPDF()

Dim MyAppID As Variant
Dim i As Long
Dim MontableauPDF As Variant
Dim Cellule_Destination As Range
On Error GoTo Erreur

MontableauPDF = Application.GetOpenFilename("Fichiers pdf (*.pdf),*.pdf", , "Selectionner les fichiers de souscription", , True)
Set MaFeuille = ActiveSheet
Sheets("Feuil2").Activate
ActiveSheet.Cells.Delete
Set Cellule_Destination = Range("A1")
For i = 1 To UBound(MontableauPDF)

MyAppID = Shell("C:\Program Files\Adobe\Acrobat 7.0\Reader\AcroRd32.exe " & Chr(34) & MontableauPDF(i) & Chr(34), vbMaximizedFocus)
AppActivate MyAppID
SendKeys "^a"
SendKeys "^c"
SendKeys "%{F4}"
DoEvents
Cellule_Destination.PasteSpecial xlPasteAll
Set Cellule_Destination = Cellule_Destination.End(xlDown).Offset(1)

Next

Extraction
Exit Sub
Erreur:

MsgBox Err.Description, vbCritical, "Erreur n° " & Err.Number, Err.HelpFile, Err.HelpContext

End Sub


et Joyeuses fêtes!
 
Dernière édition:

wilfried_42

XLDnaute Barbatruc
Re : Erreur n°9 : l'indice n'appartient pas à la sélection.

salut manu_cho

le traitement des erreurs peuvent etre utiles dans certains cas, mais ne doivent pas etre systematiques. voila un cas typique où on traite l'erreur sans la prevoir, je veux dire savoir à l'avance ce qui provoque l'erreur. dans ton cas on ne peut pas identifier la ligne qui provoque l'erreur, ce qui devient tres difficile à identifier.

je te conseille de mettre une appostrophe devant tous les on error goto erreur tu pourras alors identifier la ligne fautive à l'aide du debboger
deuxieme solution, tu mets un point d'arret à un endroit et tu suis pas à pas ton code jusqu'à provocation de l'erreur

je ne peux pas t'en dire plus.
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Re : Erreur n°5 : Arugement ou appel de procédure incorrect

Bonjour

En effet suivre ce que dis Wilfried pour savoir ce qui bloque

Sinon j'ai changé ton titre

A mon avis tu peux fair beaucoup plus simple que tes x fonctions identiques
 

manu cho

XLDnaute Nouveau
Re : Erreur n°5 : Arugement ou appel de procédure incorrect

Merci à vous deux :)

Il semblerait qu'il bug sur la ligne :

DateActivation = ExtraireDATE(MaPlage.Find("EDITE LE").Value)

Ce que je ne comprends pas, c'est que la macro fonctionne sur bons nombres de postes, mais pas sur tous (le mien notamment).

Pour la rendre plus simple, je suis preneur mais ne l'ayant pas écrite je ne vois pas trop :(
 

wilfried_42

XLDnaute Barbatruc
Re : Erreur n°5 : Arugement ou appel de procédure incorrect

re, bonjour pascal76

extrairedate est une fonction, il faut connaitre la valeur de la chaine envoyée à la fonction elle doit etre de type JJ/MM/AAAA le separateur est imperativement le caractere / sinon jour = mid --> provoquera une sortie

remplace les ligne jour, moi, annee par
jour = left(chaine,2)
mois = mid(chaine,4,2)
annee = right(chaine,4)

ajout : verifie que l'argument envoyé est bien du type string et celui qui recoit le resultat de la fonction de type date

re-ajout : si ta plage est de type date
DateActivation = ExtraireDATE(cstr(MaPlage.Find("EDITE LE").Value))

 
Dernière édition:

Hervé

XLDnaute Barbatruc
Re : Erreur n°5 : Arugement ou appel de procédure incorrect

bonjour tout le monde

il faudrait aussi, manu, s'assurer que l'on envoi bien une date à la fonction ExtraireDATE.

car avec : MaPlage.Find("EDITE LE").Value on va renvoyer "EDITE LE" à la fonction.

non ?

salut
 

manu cho

XLDnaute Nouveau
Re : Erreur n°5 : Arugement ou appel de procédure incorrect

Bonjour,


Les tests proposés n'ont pas donné lieu à un résultat positif, je suis largué :(
En plus, les PDF varient en teneur, et tout se trouve décaler, je ne comprends plus rien !

Est-il possible de synthétiser un peu ce code ?
 

Discussions similaires

Statistiques des forums

Discussions
312 219
Messages
2 086 369
Membres
103 197
dernier inscrit
sandrine.lacaussade@orang