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

Question

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

jordane45 · Answer

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

eriiic · Answer

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

Mosca · Answer

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+

r4944 · Answer

Bonjour , 

voici mon nouveau code aprés l'avoir identé :

j'ai  toujours la même erreur ;

Private Sub CommandButton3_Click()Dim OutApp As ObjectDim 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 StringDim fr(1 To 10) As String Set wordApp = CreateObject("word.Application")              Application.ScreenUpdating = FalseSet 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 icleanup:Set OutApp = NothingApplication.ScreenUpdating = True        Call wordDocument.Close(Word.wdDoNotSaveChanges)        wordDocument.Save        wordDocument.Close        Set wordDocument = Nothing       Call wordApp.QuitEnd Sub

r4944 · Answer

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 icleanup:        Set OutApp = Nothing        Application.ScreenUpdating = True                Call wordDocument.Close(Word.wdDoNotSaveChanges)        wordDocument.Save        wordDocument.Close        Set wordDocument = Nothing        Call wordApp.Quit    End Sub

Mosca · Answer

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 icleanup: Set OutApp = Nothing Application.ScreenUpdating = True        Call wordDocument.Close(Word.wdDoNotSaveChanges)        wordDocument.Save        wordDocument.Close        Set wordDocument = Nothing        Call wordApp.QuitEnd Sub

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

6 réponses

Discussions similaires

Newsletters