Vivien samba
XLDnaute Nouveau
Bonjour,
J'essaie de créer un macro qui permet d'enregistrer et envoyer un message à un transporteur défini, mais le problème c'est que j'arrive à saisir, enregistrer les données dans un classeur et ouvrir Outlook pour l'envoie du mail sauf que je dois saisir le mail du transporteur dans le destinataire or je veux que le macro sélection automatiquement le mail du transport pour mettre dans la barre destinataire.
Ci-joint le code macro que j'ai mis mais quand j'exécute ça me sort (erreur de compilation end if sans bloc if) je sais pas si c'est correct mon code.
Merci d'avance.
J'essaie de créer un macro qui permet d'enregistrer et envoyer un message à un transporteur défini, mais le problème c'est que j'arrive à saisir, enregistrer les données dans un classeur et ouvrir Outlook pour l'envoie du mail sauf que je dois saisir le mail du transporteur dans le destinataire or je veux que le macro sélection automatiquement le mail du transport pour mettre dans la barre destinataire.
Ci-joint le code macro que j'ai mis mais quand j'exécute ça me sort (erreur de compilation end if sans bloc if) je sais pas si c'est correct mon code.
Merci d'avance.
VB:
Private Sub Btnenreg_Click()
Dim olApp As Outlook.Application
Dim olmail As MailItem
Dim StrBody As String
Dim derligne As Integer
Dim Ligne(1 To 26) As String
Dim ol As Object, plage As Range, re As Range, fichier As String, doc As String
Dim v As Long, cel As Range, chemin As String, transporteur As String, premaddress
Set cel = Sheets("Liste des NC").Range("F4")
If MsgBox("Confirmer l'ajout de la demande ?", vbYesNo, "Confirmation") = vbYes Then
' Remplir le tableau'
With Sheets("Liste des NC")
derligne = .Range("A36").End(xlUp).Row + 1
.Cells(derligne, 1) = Textdatenc.Value
.Cells(derligne, 2) = Textbl.Value
.Cells(derligne, 3) = Cbotypenc.Value
.Cells(derligne, 4) = Cbotrans.Value
.Cells(derligne, 5) = Cbostatuttrans.Value
.Cells(derligne, 6) = Cbopole.Value
.Cells(derligne, 7) = Textclient.Value
.Cells(derligne, 8) = Textcodepostal.Value
.Cells(derligne, 9) = Textville.Value
.Cells(derligne, 10) = TextQténc.Value
.Cells(derligne, 11) = Textestimation.Value
.Cells(derligne, 12) = Textpénalités.Value
.Cells(derligne, 13) = Textremarque.Value
Ligne1 = "Date"
Ligne2 = "N° BL"
Ligne3 = "Type nc"
Ligne4 = "Transporteur"
Ligne5 = "Statut"
Ligne6 = "Pôle"
Ligne7 = "Client"
Ligne8 = "Code Postal"
Ligne9 = "Ville"
Ligne10 = "Quantité"
Ligne11 = "Coût nc"
Ligne12 = "Pénalités"
Ligne13 = "Remarques"
Ligne14 = .Cells(derligne, 1)
Ligne15 = .Cells(derligne, 2)
Ligne16 = .Cells(derligne, 3)
Ligne17 = .Cells(derligne, 4)
Ligne18 = .Cells(derligne, 5)
Ligne19 = .Cells(derligne, 6)
Ligne20 = .Cells(derligne, 7)
Ligne21 = .Cells(derligne, 8)
Ligne22 = .Cells(derligne, 9)
Ligne23 = .Cells(derligne, 10)
Ligne24 = .Cells(derligne, 11)
Ligne25 = .Cells(derligne, 12)
Ligne26 = .Cells(derligne, 13)
End With
Set olApp = CreateObject("Outlook.Application")
Set olmail = olApp.CreateItem(olMailItem)
StrBody = "Bonjour , ci joint les données de la nouvelle non-conformité qui vous a été attribuée ..." & vbCrLf & vbCrLf & _
vbCrLf & Ligne1 & " " & Ligne2 & " " & Ligne3 & " " & Ligne4 & " " & Ligne5 & " " & Ligne6 & " " & Ligne7 & " " & Ligne8 & " " & Ligne9 & " " & Ligne10 & " " & Ligne11 & " " & Ligne12 & " " & Ligne13 & vbCrLf _
& vbCrLf & Ligne14 & " " & Ligne15 & " " & Ligne16 & " " & Ligne17 & " " & Ligne18 & " " & Ligne19 & " " & Ligne20 & " " & Ligne21 & " " & Ligne22 & " " & Ligne23 & " " & Ligne24 & " " & Ligne25 & " " & Ligne26
With olmail
.To = ""
.Subject = "Nouvelle non-conformité"
.Body = StrBody
.Display
End With
Set olmail = Nothing
Set olApp = Nothing
'Range("B2:K14").ClearContents
'et en fonction du transporteur en cellule l144 de la feuille test aller chercher les mail corespondant dans la feuille carnet d'adresse
transporteur = Worksheets("carnet d'adresses").Range("G4") 'récupérer le nom du transporteur
x = Sheets("Liste des NC").Range("d" & Rows.Count).End(xlUp).Row
Set plage = Sheets("Liste des NC").Range("d4:a" & x)
Set re = plage.Find(transporteur, xlValues, xlWhole) 'rechercher transporteur dans carnet d'adresse
destinataires = "Transporteur"
If Not re Is Nothing Then
premaddress = re.Address
Do
' on prépare la liste des destinataires
destinataires = destinataires & re.Offset(0, 1) & ";"
Set re = plage.FindNext(re)
Loop While Not re Is Nothing And re.Address <> premaddress
End If
End Sub
Dernière édition:
