erreur de compilation caractère incorrect

erreur de compilation caractère incorrect - VB/VBA/VBS - Programmation

Marsh Posté le 21-10-2020 à 14:04:52    

Bonjour à tous,
 
C'est mon premier post ici, avant, j'ai bien pris le soin de vérifier si je trouvais des réponses ici, il se peut que du fait de mon peu d'expérience, je sois passé à coté.
 
Je bute sur une macro dont une partie s'exécute de temps en temps mais me renvoie dans 99 % des cas un message d'erreur de compilation avec la mention caractère incorrect.
 
Si l'un de vous peut m'éclairer, peut être est ce juste dans la manière de lancer la macro? (Je suis un vrai néophyte)
 
Le but du script est de créer à partir d'un publipostage word un export de chaque feuille (Attestation de sortie) en PDF en le nommant individuellement
 
Dans un deuxième je chercherais à automatiser l'envoi par mail.
 
Merci pour vos lumières qui me sortiront de mon impasse.
 
Voici le script :

Code :
  1. Sub Impression()
  2. '
  3. ' Impression Macro
  4. '
  5. '
  6. NbPage = ActiveDocument.Windows(1).Panes(1).Pages.Count
  8. For i = 1 To NbPage
  10. Dim nom
  12. nom = ActiveDocument.Sections(i).Range.Paragraphs(16).Range.Words(3)
  14. prenom = ActiveDocument.Sections(i).Range.Paragraphs(17).Range.Words(3)
  16.     ActiveDocument.ExportAsFixedFormat OutputFileName:= _
  17.         "C:\Users\10012055U\Desktop\Test\Attestation Ligue1 " & nom & prenom & ".pdf", _
  18.         ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
  19.         wdExportOptimizeForPrint, From:=i, To:=i, Range:=wdExportFromTo, _
  20.         Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
  21.         CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
  22.         BitmapMissingFonts:=True, UseISO19005_1:=False
  23.     ChangeFileOpenDirectory "C:\Users\10012055U\Desktop\Test\"
  24.    
  25. Next
  26.    
  27.        
  28. End Sub


 
 
David.


---------------
Je suis néophyte et je n\
Reply

Marsh Posté le 21-10-2020 à 14:04:52   

Reply

Marsh Posté le 21-10-2020 à 17:09:37    

Bonjour,
en exécutant la macro pas à pas (Débogage > Pas à pas détaillé ou F8), tu devrais cerner l'endroit et le moment où ça pose problème.
 
Est-ce que la valeur de i définit par [1..NBPage] fait toujours référence à une section existante ? Ligne 12, 14 ou 19

Message cité 1 fois
Reply

Marsh Posté le 21-10-2020 à 21:12:35    

Bonjour,
 
Le nombre de pages et le nombre de sections c'est pas la même chose, (même si dans ton document ils sont identiques). Il faut être cohérent dans le code.
Essaies comme ça :

Code :
  1. Option Explicit
  2. Sub Impression()
  3. '
  4. ' Impression Macro
  5. '
  6. Dim nom As String
  7. Dim prenom As String
  8. Dim nomPdf As String
  9. Dim i As Integer
  10.   With ActiveDocument
  11.     For i = 1 To .Sections.Count
  12.       nom = ActiveDocument.Sections(i).Range.Paragraphs(16).Range.Words(3)
  13.       prenom = ActiveDocument.Sections(i).Range.Paragraphs(17).Range.Words(3)
  14.       nomPdf = "C:\Users\10012055U\Desktop\Test\Attestation Ligue1 " & nom & prenom & ".pdf"
  15.       ActiveDocument.ExportAsFixedFormat OutputFileName:=nomPdf, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
  16.                                          OptimizeFor:=wdExportOptimizeForPrint, From:=i, To:=i, Range:=wdExportFromTo, _
  17.                                          Item:=wdExportDocumentContent, IncludeDocProps:=True, _
  18.                                          CreateBookmarks:=wdExportCreateNoBookmarks
  19.     Next i
  20.   End With
  21. End Sub


Il se peut aussi que nom ou prénom contienne un caractère interdit dans les noms de fichier.

Message cité 1 fois

---------------
Cordialement, Patrice
Reply

Marsh Posté le 24-10-2020 à 10:15:59    

itela a écrit :

Bonjour,
en exécutant la macro pas à pas (Débogage > Pas à pas détaillé ou F8), tu devrais cerner l'endroit et le moment où ça pose problème.
 
Est-ce que la valeur de i définit par [1..NBPage] fait toujours référence à une section existante ? Ligne 12, 14 ou 19


 
Merci pour ton message. Comme je te l'ai dit, je suis débutant mais j'essaye de progresser. En fait je ne voyais pas que dans un onglet, j'avais un autre script qui se lançait à chaque fois que je lançais le mien.
 
EN ce qui concerne la cohérence Pages/Sections ActiveDocument.Pages ne marchait pas alors que sections marchait... La demarche du débutant qui essaye.
 
Merci en tout cas, car je continue à progresser.

Reply

Marsh Posté le 24-10-2020 à 10:21:32    

patrice33740 a écrit :

Bonjour,
 
Le nombre de pages et le nombre de sections c'est pas la même chose, (même si dans ton document ils sont identiques). Il faut être cohérent dans le code.
Essaies comme ça :

Code :
  1. Option Explicit
  2. Sub Impression()
  3. '
  4. ' Impression Macro
  5. '
  6. Dim nom As String
  7. Dim prenom As String
  8. Dim nomPdf As String
  9. Dim i As Integer
  10.   With ActiveDocument
  11.     For i = 1 To .Sections.Count
  12.       nom = ActiveDocument.Sections(i).Range.Paragraphs(16).Range.Words(3)
  13.       prenom = ActiveDocument.Sections(i).Range.Paragraphs(17).Range.Words(3)
  14.       nomPdf = "C:\Users\10012055U\Desktop\Test\Attestation Ligue1 " & nom & prenom & ".pdf"
  15.       ActiveDocument.ExportAsFixedFormat OutputFileName:=nomPdf, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
  16.                                          OptimizeFor:=wdExportOptimizeForPrint, From:=i, To:=i, Range:=wdExportFromTo, _
  17.                                          Item:=wdExportDocumentContent, IncludeDocProps:=True, _
  18.                                          CreateBookmarks:=wdExportCreateNoBookmarks
  19.     Next i
  20.   End With
  21. End Sub


Il se peut aussi que nom ou prénom contienne un caractère interdit dans les noms de fichier.


 
Merci Patrice pour ta réponse. EN ce qui concerne l'erreur, il s'agit d'un script dans un autre onglet qui mettait le bazaar. Effectivement prendre en compte les sections dès le début semble bien plus logique. EN ce qui concerne les caractère spéciaux, moi meme j'ai été surpris qu'il accepte de créer des noms avec accent ou cedille... Mais par prévention, je les remplace manuellement avant d'executer la macro. Je pense m'attaquer à une pacro pour les substituer prochainement.
 
Merci en tout cas pour ton assistance.
 
Bonne journée.

Reply

Marsh Posté le 24-10-2020 à 10:33:42    

Salut, peut-être que l'usage de ces fonctions te faciliteront la tâche ? en les adaptant à ton contexte.
 

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function


 
ainsi que :

Function SupprimerAccents(ByVal sChaine As String) As String
Dim i As Long, p As Long
Const sCarAvecAccent As String = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    For i = 1 To Len(sChaine)
        p = InStr(sCarAvecAccent, Mid(sChaine, i, 1))
        If p > 0 Then Mid$(sChaine, i, 1) = Mid$(sCarSansAccent, p, 1)
    Next i
    SupprimerAccents = sChaine
End Function


ou

Option Explicit
 
Private Declare Function FoldString Lib "kernel32.dll" Alias _
                                    "FoldStringA" (ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, _
                                                   ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
 
Function SupprimerAccentsAPI(ByVal sStr As String) As String
Dim i As Long
    SupprimerAccentsAPI = Space(Len(sStr))
    For i = 0 To (Len(sStr) - 1) * 2 Step 2
        FoldString &H40, StrPtr(sStr) + i, 1, StrPtr(SupprimerAccentsAPI) + i, 1
    Next i
End Function


 
SupprimerAccents peut demander des ajouts à sCarAvecAccent / sCarSansAccent contrairement à SupprimerAccentsAPI ( ici pour Office 32 bits )
Courriertv : Inutile de fonctionner par psittacisme cela n'apporte rien d'autant plus que le code à évolué depuis.

Message cité 1 fois
Message édité par kiki29 le 23-11-2020 à 17:27:06
Reply

Marsh Posté le 26-10-2020 à 14:26:47    

kiki29 a écrit :

Salut, peut-être que l'usage de ces fonctions te faciliteront la tâche ? en les adaptant à ton contexte.
 

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function


 
ainsi que :
 

Option Explicit
 
Private Declare Function FoldString Lib "kernel32.dll" Alias _
                                    "FoldStringA" (ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, _
                                                   ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
 
Function SupprimerAccentsAPI(ByVal sStr As String) As String
Dim i As Long
    SupprimerAccentsAPI = Space(Len(sStr))
    For i = 0 To (Len(sStr) - 1) * 2 Step 2
        FoldString &H40, StrPtr(sStr) + i, 1, StrPtr(SupprimerAccentsAPI) + i, 1
    Next i
End Function


ou

Function SupprimerAccents(ByVal sChaine As String) As String
Dim sTmp As String, i As Long, p As Long
Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
 
    sTmp = sChaine
    For i = 1 To Len(sTmp)
        p = InStr(sCarAccent, Mid(sTmp, i, 1))
        If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
    Next i
    SupprimerAccents = sTmp
End Function



 
Merci des scripts à conserver précieusement, plus qu'utiles.
 
Bonne semaine à vous tous.
 
David

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed