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

r4944 Messages postés 136 Statut Membre -  
eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   -
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

6 réponses

  1.
    jordane45 Messages postés 30427 Date d'inscription   Statut Modérateur Dernière intervention   4 831
     
    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
  2. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    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
  3. Mosca
     
    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
  4. r4944 Messages postés 136 Statut Membre
     
    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
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      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
    2. r4944 Messages postés 136 Statut Membre
       
      Merci beaucoup Eric je vais essayer de l'installer maintenant
      0

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

    Posez votre question
  6. r4944 Messages postés 136 Statut Membre
     
    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
  7. Mosca
     
    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
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      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

le caractère (Alt+255)
thabetchokri -
morganch -

1 réponse
6000 caractère espaces compris --> pages
Sasha -
_Ritchi_ -

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

2 réponses
Alt Codes français > 255
Nakat -
C-Claire -

1 réponse
Comment insérer correctement des caractères spéciaux ou émojis ?
Lia -
Cct -

45 réponses