Sujet Précédent Sujet Suivant

Comment dépasser la limite de 255 caractères ()

Fermé
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017 - Modifié par pijaku le 3/03/2016 à 16:17
eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 - 3 mars 2016 à 22:45
Bonjour voici mon code qui sert a envoyer des courriels d'une maniére automatique à travers outlook qui contiennent les experiences qui manque chaque condidat , j'utilise un modele word où j'ai mis une variable 'VariableToReplace' cette variable doit etre remplacé par la variable experience dans le code , (le choix du modèle se fait à partir d'un user form 
     wordApp.Documents.Open "txtExcelDatasheet = vaFiles(i)"
(txtExceDatasheet c'est le chemin de mon fichier word ))

une fois la variable 'VariableToReplace' est remplacé , on enregistre une copie PDF du courriel et apres on envoie le courriel avec le fichier PDF en piéce jointe.

mon probléme c'est que j'arrive pas à compiler à cause de ce message d'erreur (Next without for ) en plus Word n'accepte pas plus de 255 caractéres alors que parfois je dois dèpasser cette limite.

est ce que quelqu'un peut m'aider ?
vos suggestions seront les bienvenue

voici mon code ; 

Private Sub CommandButton3_Click()
Dim OutApp As Object
Dim OutMail As Object
 Dim i As Integer
 Dim Exp As Byte
 Dim wordDocument As Word.Document
 Dim experience As String
 Dim experience_part As String
 Dim wordApp As Word.Application
 Dim bodymessage(0 To 9) As String
Dim fr(1 To 10) As String
 Set wordApp = CreateObject("word.Application")
     
    
     Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
    
 
 For i = 8 To Sheets("SBR").Cells(ActiveSheet.Rows.Count, 1).End(xlUp).row
   
     If Sheets("SBR").Cells(i, 44) = "OUT" And ActiveSheet.Cells(i, 1) <> "" Then
         wordApp.Documents.Open "txtExcelDatasheet = vaFiles(i)"
  
         Set wordDocument = wordApp.ActiveDocument
    
    bodymessage(0) = ""
    bodymessage(1) = ""
    bodymessage(2) = ""
    
    fr(1) = ""
    fr(2) = ""
    fr(3) = ""
   
   If Sheets("SBR").Cells(i, 3).Text Like "?*@?*.?*" And _
       LCase(Cells(i, "AR").Value) = "OUT" Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
       ' .SentOnBehalfOfName = Sheets("Screening-email results").Range("T14")
       .To = ActiveSheet.Cells(i, 3).Text
        .Subject = " Screening results / "
  
  
  .Attachments.Add "C:\Users\xx\Desktop\TEST\" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
  
  
  
  For Exp = 1 To 10
            Select Case Exp
                Case 1 To 10
                
                'Abilities/ capacities'
               
                    
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "Educ" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B19").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E19").Text
                    End If

                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX1" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B25").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E25").Text
                    End If

                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX2" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B26").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E26").Text
                    End If
                      If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX3" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B27").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E27").Text
                    End If

        Next Exp




        experience = bodymessage(0) & bodymessage(1) & bodymessage(2) &  fr(0) _
        & fr(1) & fr(2) 
    
 
 
 
    
    If Len(experience) > 200 Then
    Do While Len(experience) >= 200
    experience_part = Left(experience, 200) & "VariableToReplace"
    experience = Right(experience, Len(experience) - 200)
    wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience_part, Replace:=wdReplaceAll
    Loop
    wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll

Else
wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll
End If
         
            
      wordDocument.Content.Find.Execute FindText:="VariableGroupe", ReplaceWith:=ActiveSheet.Cells(i, i + 1).Text, Replace:=wdReplaceAll
                
        
        
        
        
        wordDocument.SaveAs "C:\Users\xx\Desktop\TEST" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
     
            
            'set placeholder variable back
     
        wordDocument.Content.Find.Execute FindText:=experience, ReplaceWith:="VariableToReplace", Replace:=wdReplaceAll

        
     'End If

       
 Next i
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

        Call wordDocument.Close(Word.wdDoNotSaveChanges)
        wordDocument.Save
        wordDocument.Close
        Set wordDocument = Nothing
       Call wordApp.Quit
End Sub
A voir également:

6 réponses

Réponse 1 / 6
jordane45 Messages postés 38144 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 21 avril 2024 4 650
3 mars 2016 à 15:49
Bonjour,

Il semble que tu aies un IF et un With qui ne sont pas fermés ....

Remet ton code en forme avec l'indentation et tu devrais pouvoir trouver
1
Réponse 2 / 6
eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 213
3 mars 2016 à 15:52
Bonjour,

indente correctement ton code et tu verras qu'il ne manque pas que ça.
Il maque un end select, un end with, plusieurs end if
Là ce n'est plus de l'inattention, n'hésite pas à te servir de l'aide qui est très bien faite.

en plus Word n'accepte pas plus de 255 caractéres
Ca se saurait...
eric
1
Réponse 3 / 6
Mosca
3 mars 2016 à 15:59
Bonjour,

Pour le message d'erreur (Next without For), cela provient des blocs If...End If .
Il manque des End If.
Quand il y a des blocs imbriqués, il faut bien indenter le code (aligner For..Next, If..End If, Do..Loop, etc) pour bien faire ressortir la structure du programme, et faciliter la relecture.

Pour ce qui est de la limite de 255 caractères, ça m'étonnerait que Word ne puisse dépasser cette limite.
A quel niveau du programme se situe cette limite?

A+
1
Réponse 4 / 6
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
3 mars 2016 à 19:19
Bonjour ,

voici mon nouveau code aprés l'avoir identé :

j'ai toujours la même erreur ; 

Private Sub CommandButton3_Click()
Dim OutApp As Object
Dim OutMail As Object
 Dim i As Integer
 Dim Exp As Byte
 Dim wordDocument As Word.Document
 Dim experience As String
 Dim experience_part As String
 Dim wordApp As Word.Application
 Dim bodymessage(0 To 9) As String
Dim fr(1 To 10) As String
 Set wordApp = CreateObject("word.Application")
     
    
     Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
    
 
 For i = 8 To Sheets("SBR").Cells(ActiveSheet.Rows.Count, 1).End(xlUp).row
   
     If Sheets("SBR").Cells(i, 44) = "OUT" And ActiveSheet.Cells(i, 1) <> "" Then
         wordApp.Documents.Open "txtExcelDatasheet = vaFiles(i)"
  
         Set wordDocument = wordApp.ActiveDocument
    
    bodymessage(0) = ""
    bodymessage(1) = ""
    bodymessage(2) = ""
    bodymessage(3) = ""
    bodymessage(4) = ""
    bodymessage(5) = ""
    bodymessage(6) = ""
    bodymessage(7) = ""
    bodymessage(8) = ""
    bodymessage(9) = ""
    fr(1) = ""
    fr(2) = ""
    fr(3) = ""
    fr(4) = ""
    fr(5) = ""
    fr(6) = ""
    fr(7) = ""
    fr(8) = ""
    fr(9) = ""
    fr(10) = ""
   
   If Sheets("SBR").Cells(i, 3).Text Like "?*@?*.?*" And _
       LCase(Cells(i, "AR").Value) = "OUT" Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
       ' .SentOnBehalfOfName = Sheets("Screening-email results").Range("T14")
        .To = ActiveSheet.Cells(i, 3).Text
        .Subject = " Screening results / "
        .Attachments.Add "C:\Users\riadh.said\Desktop\TEST\" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
  
  
  
   For Exp = 1 To 10
            Select Case Exp
                Case 1 To 10
                
                'Abilities/ capacities'
                
                    
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "Educ" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B19").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E19").Text
                    End If
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX1" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B25").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E25").Text
                    End If
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX2" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B26").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E26").Text
                    End If
                      If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX3" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B27").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E27").Text
                    End If
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX4" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B28").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E28").Text
                    End If
                      If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX5" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B29").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E29").Text
                    End If
                      If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX6" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B30").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E30").Text
                    End If
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX7" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B31").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E31").Text
                    End If
                    
                      
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX8" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B32").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E32").Text
                    End If
                    
                    
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX9" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B33").TeQt
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E33").Text
                    End If
                    
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "EX10" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B34").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E34").Text
                    End If
                   
                   
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "A1" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B71").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E71").Text
                    End If
                    
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "PS1" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B83").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E83").Text
            
                    End If
                    
            
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "PS2" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B84").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E84").Text
          
                    End If
     
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "A2" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B72").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("C72").Text
                    End If
                                    'Atouts'
       
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "AED1" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B45").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("C45").Text
                    End If
     
                    If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "AED2" Then
                        bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B46").Text
                        fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("C46").Text
                    End If
                    
            End Select
        Next Exp




        experience = bodymessage(0) & bodymessage(1) & bodymessage(2) & bodymessage(3) & bodymessage(4) & bodymessage(5) & bodymessage(6) & bodymessage(7) & bodymessage(8) & bodymessage(9) & fr(0) _
        & fr(1) & fr(2) & fr(3) & fr(4) & fr(5) & fr(6) & fr(7) & fr(8) & fr(9) & fr(10)
    
 
 
 
    
    If Len(experience) > 200 Then
    Do While Len(experience) >= 200
    experience_part = Left(experience, 200) & "VariableToReplace"
    experience = Right(experience, Len(experience) - 200)
    wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience_part, Replace:=wdReplaceAll
    Loop
    wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll

    Else
    wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll
    
    End If
         
            
      wordDocument.Content.Find.Execute FindText:="VariableGroupe", ReplaceWith:=ActiveSheet.Cells(i, i + 1).Text, Replace:=wdReplaceAll
                
      wordDocument.SaveAs "C:\Users\riadh.said\Desktop\TEST" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
     
            
            'set placeholder variable back
      
        wordDocument.Content.Find.Execute FindText:=experience, ReplaceWith:="VariableToReplace", Replace:=wdReplaceAll

        
     End If
     End If
     End If
       
 Next i
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

        Call wordDocument.Close(Word.wdDoNotSaveChanges)
        wordDocument.Save
        wordDocument.Close
        Set wordDocument = Nothing
       Call wordApp.Quit
End Sub
0
eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 213
Modifié par eriiic le 3/03/2016 à 19:49
L'indenter correctement ne corrige pas tes erreurs mais les met en évidence.
Là en l'occurence c'est toujours mal indenté.
Dès que tu démarres une structure (For, Do, With, etc) les lignes en-dessous doivent toutes être décalées à droite.
Lorsque tu la fermes tu dois indenter à gauche. Ainsi If, Else, Endif sont alignés verticalement et tu vois tout de suite que c'est bon. Les lignes entre sont décalées à droite et ne gênent pas la lecture.

Tu peux installer SmartIndent qui le fait pour toi sans erreur, tu verras tout de suite où ça cloche. (non écrit mais compatible même avec office 2016)
0
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
3 mars 2016 à 19:54
Merci beaucoup Eric je vais essayer de l'installer maintenant
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
3 mars 2016 à 20:52
je l'ai identé , malheureusement je vois pas une structre qui est ouverte :/ 

Private Sub CommandButton3_Click()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim i As Integer
    Dim Exp As Byte
    Dim wordDocument As Word.Document
    Dim experience As String
    Dim experience_part As String
    Dim wordApp As Word.Application
    Dim bodymessage(0 To 9) As String
    Dim fr(1 To 10) As String
    Set wordApp = CreateObject("word.Application")
    
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo cleanup
    
    
    For i = 8 To Sheets("SBR").Cells(ActiveSheet.Rows.Count, 1).End(xlUp).row
        
        If Sheets("SBR").Cells(i, 44) = "OUT" And ActiveSheet.Cells(i, 1) <> "" Then
            wordApp.Documents.Open "txtExcelDatasheet = vaFiles(i)"
            
            Set wordDocument = wordApp.ActiveDocument
            
            bodymessage(0) = ""
            bodymessage(1) = ""
            bodymessage(2) = ""
            bodymessage(3) = ""
            bodymessage(4) = ""
            bodymessage(5) = ""
            bodymessage(6) = ""
            bodymessage(7) = ""
            bodymessage(8) = ""
            bodymessage(9) = ""
            fr(1) = ""
            fr(2) = ""
            fr(3) = ""
            fr(4) = ""
            fr(5) = ""
            fr(6) = ""
            fr(7) = ""
            fr(8) = ""
            fr(9) = ""
            fr(10) = ""
            
            If Sheets("SBR").Cells(i, 3).Text Like "?*@?*.?*" And _
            LCase(Cells(i, "AR").Value) = "OUT" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
' .SentOnBehalfOfName = Sheets("Screening-email results").Range("T14")
                .To = ActiveSheet.Cells(i, 3).Text
                .Subject = " Screening results / "
                .Attachments.Add "C:\Users\riadh.said\Desktop\TEST\" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
                
                
                
                For Exp = 1 To 10
                    Select Case Exp
                    Case 1 To 10
                        
'Abilities/ capacities'
                        
                        
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "Educ" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B19").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E19").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX1" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B25").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E25").Text
                        End If
                     
                        
                    End Select
                    Next Exp
                    
                    
                    
                    
                    experience = bodymessage(0) & bodymessage(1) & bodymessage(2) & bodymessage(3) & bodymessage(4) & bodymessage(5) & bodymessage(6) & bodymessage(7) & bodymessage(8) & bodymessage(9) & fr(0) _
                    & fr(1) & fr(2) & fr(3) & fr(4) & fr(5) & fr(6) & fr(7) & fr(8) & fr(9) & fr(10)
                    
                    
                    
                    
                    
                    If Len(experience) > 200 Then
                        Do While Len(experience) >= 200
                            experience_part = Left(experience, 200) & "VariableToReplace"
                            experience = Right(experience, Len(experience) - 200)
                            wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience_part, Replace:=wdReplaceAll
                        Loop
                        wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll
                        
                    Else
                        wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll
                        
                    End If
                    
                    
                    wordDocument.Content.Find.Execute FindText:="VariableGroupe", ReplaceWith:=ActiveSheet.Cells(i, i + 1).Text, Replace:=wdReplaceAll
                    
                    wordDocument.SaveAs "C:\Users\riadh.said\Desktop\TEST" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
                    
                    
'set placeholder variable back
                    
                    wordDocument.Content.Find.Execute FindText:=experience, ReplaceWith:="VariableToReplace", Replace:=wdReplaceAll
                    
                    
                End If
            End If
        End If
        
        Next i
cleanup:
        Set OutApp = Nothing
        Application.ScreenUpdating = True
        
        Call wordDocument.Close(Word.wdDoNotSaveChanges)
        wordDocument.Save
        wordDocument.Close
        Set wordDocument = Nothing
        Call wordApp.Quit
    End Sub
0
Réponse 6 / 6
Mosca
3 mars 2016 à 21:00
Bonsoir,

C'est vrai que c'est pas évident, surtout quand la procédure est assez longue
Tiens, j'ai corrigé pour toi. tu peux comparer avec ce que tu as fais.
Au passage, j'ai enlevé la structure Select Case..End Select qui ne servait à rien.

Bonne continuation 

Private Sub CommandButton3_Click()
 Dim OutApp As Object
 Dim OutMail As Object
 Dim i As Integer
 Dim Exp As Byte
 Dim wordDocument As Word.Document
 Dim experience As String
 Dim experience_part As String
 Dim wordApp As Word.Application
 Dim bodymessage(0 To 9) As String
 Dim fr(1 To 10) As String
 Set wordApp = CreateObject("word.Application")
 Application.ScreenUpdating = False
 Set OutApp = CreateObject("Outlook.Application")
 On Error GoTo cleanup
 For i = 8 To Sheets("SBR").Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   
    If Sheets("SBR").Cells(i, 44) = "OUT" And ActiveSheet.Cells(i, 1) <> "" Then
        wordApp.Documents.Open "txtExcelDatasheet = vaFiles(i)"
  
        Set wordDocument = wordApp.ActiveDocument
    
        bodymessage(0) = ""
        bodymessage(1) = ""
        bodymessage(2) = ""
        bodymessage(3) = ""
        bodymessage(4) = ""
        bodymessage(5) = ""
        bodymessage(6) = ""
        bodymessage(7) = ""
        bodymessage(8) = ""
        bodymessage(9) = ""
        fr(1) = ""
        fr(2) = ""
        fr(3) = ""
        fr(4) = ""
        fr(5) = ""
        fr(6) = ""
        fr(7) = ""
        fr(8) = ""
        fr(9) = ""
        fr(10) = ""
   
        If Sheets("SBR").Cells(i, 3).Text Like "?*@?*.?*" And _
        LCase(Cells(i, "AR").Value) = "OUT" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                ' .SentOnBehalfOfName = Sheets("Screening-email results").Range("T14")
                .To = ActiveSheet.Cells(i, 3).Text
                .Subject = " Screening results / "
                .Attachments.Add "C:\Users\riadh.said\Desktop\TEST\" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
            End With
  
  
                For Exp = 1 To 10
                        'Abilities/ capacities'
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "Educ" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B19").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E19").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX1" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B25").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E25").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX2" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B26").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E26").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX3" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B27").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E27").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX4" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B28").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E28").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX5" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B29").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E29").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX6" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B30").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E30").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX7" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B31").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E31").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX8" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B32").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E32").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(4, 23 + Exp) = "EX9" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B33").TeQt
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E33").Text
                        End If
                    
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "EX10" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B34").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E34").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "A1" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B71").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E71").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "PS1" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B83").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E83").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "PS2" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B84").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("E84").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "A2" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B72").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("C72").Text
                        End If
                                    'Atouts'
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "AED1" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B45").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("C45").Text
                        End If
                        If LCase(Cells(i, 23 + Exp).Text) = "DNM" And Sheets("SBR").Cells(2, 23 + Exp) = "AED2" Then
                            bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("Process Info").Range("B46").Text
                            fr(Exp) = vbNewLine & " ** " & Sheets("Process Info").Range("C46").Text
                        End If
                Next Exp




                experience = bodymessage(0) & bodymessage(1) & bodymessage(2) & bodymessage(3) & bodymessage(4) & _
                bodymessage(5) & bodymessage(6) & bodymessage(7) & bodymessage(8) & bodymessage(9) & fr(0) _
                & fr(1) & fr(2) & fr(3) & fr(4) & fr(5) & fr(6) & fr(7) & fr(8) & fr(9) & fr(10)
    
 
 
 
    
                If Len(experience) > 200 Then
                    Do While Len(experience) >= 200
                        experience_part = Left(experience, 200) & "VariableToReplace"
                        experience = Right(experience, Len(experience) - 200)
                        wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience_part, Replace:=wdReplaceAll
                    Loop
                    wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll

                Else
                    wordDocument.Content.Find.Execute FindText:="VariableToReplace", ReplaceWith:=experience, Replace:=wdReplaceAll
    
                End If
         
            
                wordDocument.Content.Find.Execute FindText:="VariableGroupe", ReplaceWith:=ActiveSheet.Cells(i, i + 1).Text, Replace:=wdReplaceAll
                
                wordDocument.SaveAs "C:\Users\riadh.said\Desktop\TEST" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
     
            
                'set placeholder variable back
      
                wordDocument.Content.Find.Execute FindText:=experience, ReplaceWith:="VariableToReplace", Replace:=wdReplaceAll

        End If
    End If
 Next i
cleanup:
 Set OutApp = Nothing
 Application.ScreenUpdating = True

        Call wordDocument.Close(Word.wdDoNotSaveChanges)
        wordDocument.Save
        wordDocument.Close
        Set wordDocument = Nothing
        Call wordApp.Quit
End Sub
0
eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 213
3 mars 2016 à 22:45
je l'ai identé , malheureusement je vois pas une structre qui est ouverte :/
Ton end sub est indenté. Il devrait être collé à gauche à la verticale du Sub, donc il y a une erreur de structure.
Qu'est-ce tu dois lire à la verticale de With pour le fermer ?
0

Discussions similaires

1500 signes équivaut à combien de ligne dans un document wor
Thierrybidias -
Raymond PENTIER -

2 réponses
Caractères Unicode
Stepel -
Whismeril -

3 réponses
Caractères spéciaux dans son nom FACEBOOK
sullicreta78 -
Ui -

95 réponses
À combien de pages équivaut 25 000 caractères ?
-Romane- -
kergad -

16 réponses
Encodage des caractères - Problème
lourdchien -
lourdchien -

4 réponses