XL 2019 Erreur de compilation end if sans bloc if

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.

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:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Vivien, Yeahou,
Indentez votre code; Non seulement c'est plus lisible mais cela évite les erreurs.
Ainsi en indentant, on voit de suite que votre "If MsgBox(" n'est pas "fermé" par un EndIf.
NB: Testez mais je n'ai pas analysé le code, mais sans le endif ça ne pouvait pas marcher.
Code:
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 If
End Sub
 

Vivien samba

XLDnaute Nouveau
Bonjour Vivien, Yeahou,
Indentez votre code; Non seulement c'est plus lisible mais cela évite les erreurs.
Ainsi en indentant, on voit de suite que votre "If MsgBox(" n'est pas "fermé" par un EndIf.
NB: Testez mais je n'ai pas analysé le code, mais sans le endif ça ne pouvait pas marcher.
Code:
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 If
End Sub

Merci sylvanu

je viens de modifier mon message et ton code je vais essayer
merci
 

Discussions similaires

Haut Bas