Procedure too large
r
j'utilise beacoup de boucles IF a peu pres 200 conditions et malheureusement je peux pas les écrire dans des procedures différentes . est ce que y 't il quelq'un qui pourrait m'aider
Merci
Bonsoir R, bonsoir le forum,
Oui, je pense que quelqu'un pourra t'aider quand il aura compris ta question... Pourquoi pas le code qui pose problème ?!... Si ce n'est trop te demander. Ou le fichier !... Mais là je demande l'impossible non ?
r
la feuille "Exams-email results"
Re,
Arf ! R tu es un grand malade !...
Ton code simplifié (si j'ai bien compris) avec une boucle sur les 8 expériences et des tableaux de variables :
Sub Create_Mail_From_List()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim bodymessage(0 To 5) As String
Dim ex(6 To 7) As String
Dim fr(1 To 8) As String
Dim i As Integer
dim Exp As byte
Dim j As Integer
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For i = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
bodymessage(0) = ""
bodymessage(1) = ""
bodymessage(2) = ""
bodymessage(3) = ""
bodymessage(4) = ""
bodymessage(5) = ""
ex(6) = ""
ex(7) = ""
ex8 = ""
ex9 = ""
fr(1) = ""
fr(2) = ""
fr(3) = ""
fr(4) = ""
fr(5) = ""
fr(6) = ""
fr(7) = ""
fr(8) = ""
fr9 = ""
fr10 = ""
'ActiveSheet.Cells(1, 12) = ActiveSheet.Cells(1, 12) & "(" & cell.Row & "," & cell.Column & "), "
If Sheets("Screening-email results").Cells(i, 3).Text Like "?*@?*.?*" And _
LCase(Cells(i, "N").Value) = "dnm" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ActiveSheet.Cells(i, 3).Text
.Subject = Sheets("Screening-email results").Range("T2") & " / " & Sheets("Screening-email results").Range("T5")
'& "Groupe " & ActiveSheet.Cells(i, 10).Text & " / Niveau " & ActiveSheet.Cells(i, 11).Text'
For Exp = 1 To 8
Select Case Exp
Case 1 To 6
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "Educ" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B7").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C7").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX1" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B9").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C9").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX2" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B10").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C10").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX3" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B11").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C11").Text
End If
If LCase(Cells(Exp, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX4" Then
bodymessage(i - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B12").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C12").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX5" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B13").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C13").Text
End If
If LCase(Cells(Exp, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX6" Then
bodymessage(i - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B14").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C14").Text
End If
If LCase(Cells(Exp, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX7" Then
bodymessage(i - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B15").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C15").Text
End If
If LCase(Cells(Exp, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX8" Then
bodymessage(i - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B16").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C16").Text
End If
If LCase(Cells(Exp, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX9" Then
bodymessage(i - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B17").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C17").Text
End If
If LCase(Cells(Exp, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "EX10" Then
bodymessage(i - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B18").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C18").Text
End If
'Connaisances'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "K1" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B20").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C20").Text
End If
'Abilites'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "A1" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B26").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C26").Text
End If
'PERSONAL SUITABLITY'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp) = "PS1" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B35").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C35").Text
End If
Case 7 To 8
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "Educ" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B7").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C7").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX1" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B9").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C9").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX2" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B10").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C10").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX3" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B11").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C11").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX4" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B12").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C12").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX5" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B13").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C13").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX6" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B14").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C14").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX7" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B15").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C15").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX8" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B16").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C16").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX9" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B17").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C17").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "EX10" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B18").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C18").Text
End If
'CONNAISSANCES'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "K1" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B20").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C20").Text
End If
'PERSONAL SUITABLITY '
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "PS1" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B26").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C26").Text
End If
'Abilities'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Screening-email results").Cells(2, 3 + Exp).Text = "A1" Then
ex(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B35").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C35").Text
End If
End Select
Next Exp
Bodymessage6 = _
vbNewLine & vbNewLine & " Appointement Process Number: " & Sheets("Screening-email results").Range("T2") _
& vbNewLine & " Branch : " & Sheets("Screening-email results").Range("T3") _
& vbNewLine & " Position Title : " & Sheets("Screening-email results").Range("T4") _
& vbNewLine & " Group and Level: " & Sheets("Screening-email results").Range("T5") _
& vbNewLine & " Language Requirements : " & Sheets("Screening-email results").Range("T6") _
& vbNewLine & vbNewLine _
& vbNewLine & "Good Day , " _
& vbNewLine & vbNewLine & "Further to your application in the above-mentioned appointment process, I regret to inform you that you will no longer be considered. Upon review of your application, it was determined that you do not possess the following essential qualification(s), as described in the Statement of Merit Criteria:" _
Bodymessage7 = vbNewLine & vbNewLine & "If you would like to informally discuss this decision, please send an e-mail to : " & Sheets("Screening-email results").Range("T14") & " .Please submit your request as soon as possible to allow sufficient time for corrective measures to be taken, if required." _
& vbNewLine & "Please note that notifications of persons being considered and being appointed will be posted on jobs.gc.ca site"
Bodymessage8 = ". Employees are responsible for checking jobs.gc.ca site on a regular basis. If you have not already done so, I recommend you register with e-mail alerts service which allows users to automatically receive e-mail updates on new Notifications and Advertisements which may be of interest to them. More information on e-mail alerts service, including registration information, is available on jobs.gc.ca site."
Bodymessage9 = vbNewLine & "Should you require additional information, please send an e-mail to: " & Sheets("Screening-email results").Range("T15") _
& vbNewLine & vbNewLine & "Thank you for your interest in this process and may I take this opportunity to wish you success in your future endeavors." _
& vbNewLine & vbNewLine & vbNewLine & "**This e-mail message is intended for the named recipient(s) and may contain information that is privileged, confidential and/or exempt from disclosure under applicable law. Unauthorized disclosure, copying or re-transmission is prohibited. If you are not a named recipient or not authorized by the named recipient(s), or if you have received this e-mail in error, then please notify the sender immediately and delete the message and any copies.**"
Bodymessage10 = vbNewLine & " ************************************" _
& vbNewLine & _
vbNewLine & vbNewLine & " Numéro du processus de nomination " & Sheets("Screening-email results").Range("T8") _
& vbNewLine & " Direction Générale : " & Sheets("Screening-email results").Range("T9") _
& vbNewLine & " Titre du poste : " & Sheets("Screening-email results").Range("T10") _
& vbNewLine & " Groupe et niveau : " & Sheets("Screening-email results").Range("T11") _
& vbNewLine & " Exigences linguistiques : " & Sheets("Screening-email results").Range("T12") _
& vbNewLine & vbNewLine _
& vbNewLine & "Bonjour , " _
& vbNewLine & vbNewLine & "J'ai le regret de vous informer que votre candidature présentée dans le cadre du processus de nomination susmentionné n'a pas été retenue. À l'examen de votre candidature, il a été déterminé que vous ne possédez pas la(les) qualification(s) essentielle(s) suivante(s), comme elle(s) est(sont) décrite(s) dans l'Énoncé des critères de mérite :"
Bodymessage11 = vbNewLine & "Si vous souhaitez discuter de manière informelle de cette décision, veuillez envoyer un courriel à : " & Sheets("Screening-email results").Range("T14") & " .Veuillez soumettre votre demande le plus rapidement possible afin de prévoir suffisamment de temps pour que des mesures correctives puissent être prises, s'il y a lieu." _
& vbNewLine & "Veuillez noter que les notifications des personnes dont la candidature est retenue et de celles qui sont nommées seront affichées sur le site emplois.gc.ca. " _
& vbNewLine & "Il incombe aux employés de consulter périodiquement le site emplois.gc.ca. Si vous ne l'avez déjà fait, je vous conseille de vous inscrire au service d'alertes par courriel qui permet aux usagers de recevoir automatiquement, par courrier électronique, des mises à jour sur les nouvelles notifications et annonces de possibilité d'emploi qui peuvent les intéresser. Pour en savoir davantage sur le service d'alertes par courriel et sur la façon de vous y inscrire, veuillez consulter le site emplois.gc.ca." _
& vbNewLine & "Si vous avez besoin de renseignements supplémentaires, veuillez envoyer un courriel à : " & Sheets("Screening-email results").Range("T15") _
& vbNewLine & "Je vous remercie de votre intérêt pour ce processus et saisis cette occasion pour vous souhaiter un franc succès dans vos projets futurs" _
& vbNewLine & vbNewLine & vbNewLine & "**Ce message courriel s'adresse aux destinataires nommés et peut renfermer des renseignements privilégiés, confidentiels et/ou soustraits à la communication en vertu de la loi applicable. La divulgation non autorisée, la copie ou la retransmission de ce message est interdite. Si vous n'êtes pas un destinataire nommé et si vous n'êtes pas autorisé par le(s) destinataire(s) nommé(s), ou si vous avez reçu ce courriel par erreur, veuillez en aviser l'expéditeur immédiatement et supprimer le message ainsi que toute copie de celui-ci.**"
Bodymessage13 = vbNewLine & "Si vous avez besoin de renseignements supplémentaires, veuillez envoyer un courriel à : " & Sheets("Screening-email results").Range("T15") & "" _
& " Je vous remercie de votre intérêt pour ce processus et saisis cette occasion pour vous souhaiter un franc succès dans vos projets futurs." _
& vbNewLine & "Ce message courriel s'adresse aux destinataires nommés et peut renfermer des renseignements privilégiés," _
& " confidentiels et/ou soustraits à la communication en vertu de la loi applicable. La divulgation non autorisée," _
& " la copie ou la retransmission de ce message est interdite. Si vous n'êtes pas un destinataire nommé et si vous n'êtes pas autorisé par le(s) destinataire(s) nommé(s), ou si vous avez reçu ce courriel par erreur," _
& " veuillez en aviser l'expéditeur immédiatement et supprimer le message ainsi que toute copie de celui-ci.**"
.Body = Bodymessage6 & bodymessage(0) & bodymessage(1) & bodymessage(2) & bodymessage(3) & bodymessage(4) & bodymessage(5) & ex(6) & ex(7) & ex8 & ex9 & Bodymessage7 & Bodymessage8 & Bodymessage9 & Bodymessage10 & fr(1) & fr(2) & fr(3) & fr(4) & fr(5) & fr(6) & fr(7) & fr(8) & fr9 & fr10 & Bodymessage11
'"Dear " & Cells(i, "A").Value'
'.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
" " & _
" "
'End If
' If LCase(Cells(cell.Row, "F").Value) = "dnm" Then
'.Body = Sheets("lien").Range("B10").Value
'End If
'.Attachments.Add "C:\Users\riadh.said@cic.gc.ca\Desktop\" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
.Display 'Or use Display
For j = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
If LCase(ActiveSheet.Cells(i, 14).Text) = "dnm" Then
ActiveSheet.Cells(i, 15).Value = "Sent"
End If
Next j
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next i
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub