Microsoft 365 Boucle Do until

danpom302

XLDnaute Nouveau
Bonjour, j'ai un code VBA qui ne fonctionne pas. Erreur de compilation : Boucle sans Do, alors que Do est dans le code.

Pouvez-vous m'aider s.v.p. ? Dan

VB:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
'
' Sélectionner la feuille Impression multiple et la déprotéger
    Sheets("Impression multiple").Select
    ActiveSheet.Unprotect "lune666"
        
    Dim MonFichier As String
    Dim MonAdresse As String
    Dim mon_pdf As String
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Dim control_app
    Set control_app = GetObject(, "Outlook.Application")
    
' Ne pas raffraichir l'écran
    Application.ScreenUpdating = False
    
Do While Range("O3").Value > ""

        mon_pdf = Range("N2").Value
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveWorkbook.Path & "\" & mon_pdf & " .pdf", Quality:=xlQualityStandard
        MonFichier = ActiveWorkbook.Path & "\" & mon_pdf & " .pdf"
        MonAdresse = Range("AL1").Text

' 1) Si AB1 égale rien, Imprimer le contrat
        If Range("AB1").Value > "" Then
      
' 2) Imprimer le contrat de la feuille Impression Multiple
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        Range("A1").Select
    
Else
' 3) S'il y a une adresse de courriel Range("AB1"), envoyer le contrat par courriel
    With OutMail
        .To = Range("AB1").Value ' Client
        .CC = Range("AL1").Value ' Déneigeur
        .BCC = Range("AM1").Value ' Moi
        .Subject = Range("N2").Value
        .HTMLBody = "<p>Bonjour,</p>" & "<p>Ci-joint, votre contrat de déneigement pour la saison en cour. " & "<br>" & "<p>Cordialement, " & "<br>" & "<p>" & "Kevin Trottier"
        .Attachments.Add MonFichier
        .Send
        
' Ne pas raffraichir l'écran
    Application.ScreenUpdating = False
        
' Sélectionner le prochain contrat à imprimer ou à envoyer par courriel
    Range("O3:AI3").Select
    Selection.Copy
    Range("O1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("O3:AI3").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("O1").Select

Loop
    
' Sélectionner la cellule C8
    Range("C8").Select

' Enregistrer le classeur actif
    ActiveWorkbook.Save
    
End If
End Sub
 
Solution
Bonjour @danpom302

Ton code est un peu bizarre....

VB:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
'
' Sélectionner la feuille Impression multiple et la déprotéger
Sheets("Impression multiple").Select
ActiveSheet.Unprotect "lune666"

Dim MonFichier As String
Dim MonAdresse As String
Dim mon_pdf As String
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim control_app
Set control_app = GetObject(, "Outlook.Application")
   
' Ne pas raffraichir l'écran
Application.ScreenUpdating = False
   
' Exécuter ce qui suit en boucle.
Do While Range("O3") = ""
   
    If Range("AB1") = "" Then
       
    Else
' 1) Copier les données de la plage O3:AI3...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour DanPom,
En décortiquant la structure de votre macro on obtient :
VB:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
Do While Range("O3").Value > ""
        If Range("AB1").Value > "" Then
        Else
Loop
End If
End Sub
On voit que le EndIf est mal placé, il devrait se trouver avant le Loop :
Code:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
Do While Range("O3").Value > ""
        If Range("AB1").Value > "" Then
        Else
        End If
Loop
End Sub
D'où l'importance de l'indentation, c'est plus lisible.
Le texte de l'erreur est toujours mauvais quand il ne trouve pas de EndIf à sa place. Il donne une erreur sur le Do au lieu de le donner sur le If. Une plaisanterie de Bill ! 😂
 

danpom302

XLDnaute Nouveau
Bonjour DanPom,
En décortiquant la structure de votre macro on obtient :
VB:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
Do While Range("O3").Value > ""
        If Range("AB1").Value > "" Then
        Else
Loop
End If
End Sub
On voit que le EndIf est mal placé, il devrait se trouver avant le Loop :
Code:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
Do While Range("O3").Value > ""
        If Range("AB1").Value > "" Then
        Else
        End If
Loop
End Sub
D'où l'importance de l'indentation, c'est plus lisible.
Le texte de l'erreur est toujours mauvais quand il ne trouve pas de EndIf à sa place. Il donne une erreur sur le Do au lieu de le donner sur le If. Une plaisanterie de Bill ! 😂
Merci, J'essai le tout demain et vous reviens. Dan
 

danpom302

XLDnaute Nouveau
Bonjour, ça ne fonctionne pas à End If. Voici mon code corrigé.

Une suggestion s.v.p. ?

Merci,

Dan

VB:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
'
' Sélectionner la feuille Impression multiple et la déprotéger
    Sheets("Impression multiple").Select
    ActiveSheet.Unprotect "lune666"
        
    Dim MonFichier As String
    Dim MonAdresse As String
    Dim mon_pdf As String
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Dim control_app
    Set control_app = GetObject(, "Outlook.Application")
    
' Ne pas raffraichir l'écran
    Application.ScreenUpdating = False

' Exécuter ce qui suit en boucle.
Do While Range("O3") = ""

If Range("AB1") = "" Then

Else
' 1) Copier les données de la plage O3:AI3 et les coller dans la cellule O1
    Range("O3:AI3").Select
    Selection.Copy
    Range("O1").Select
    ActiveSheet.Paste

' Créer le nom du pdf pour l'enregistrement : Le No du contrat et le nom du client
    mon_pdf = [N1]
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveWorkbook.Path & "\" & mon_pdf & " .pdf", Quality:=xlQualityStandard
    MonFichier = ActiveWorkbook.Path & "\" & mon_pdf & " .pdf"

'Imprimer le contrat
   ActiveWindow.SelectedSheets.PrintOut Copies:=1

' Ne pas raffraichir l'écran.
    Application.ScreenUpdating = False

' Sélectionner le contrat suivant plage O3:AI3 puis couper les données vers O1:AI1
    Range("O3:AI3").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
        
' 1) Envoyer le contrat par courriel
With OutMail
        .To = Range("AB1").Value ' Client
        .CC = Range("AL1").Value ' Déneigeur
        .BCC = Range("AM1").Value ' Moi
        .Subject = Range("N2").Value
        .HTMLBody = "<p>Bonjour,</p>" & "<p>Ci-joint, votre contrat de déneigement pour la saison en cour. " & "<br>" & "<p>Cordialement, " & "<br>" & "<p>" & "Kevin Trottier"
        .Attachments.Add MonFichier
        .Send
        
End If

' Boucler jusqu'à ce que la cellule O3 soit vide
Loop
        
    Range("C8").Select

' Enregistrer le classeur
    ActiveWorkbook.Save

End Sub
 

Phil69970

XLDnaute Barbatruc
Bonjour @danpom302

Ton code est un peu bizarre....

VB:
Sub E_Impression_Multiple_Imprimer_Envoi_De_Courriel()
'
' Sélectionner la feuille Impression multiple et la déprotéger
Sheets("Impression multiple").Select
ActiveSheet.Unprotect "lune666"

Dim MonFichier As String
Dim MonAdresse As String
Dim mon_pdf As String
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim control_app
Set control_app = GetObject(, "Outlook.Application")
   
' Ne pas raffraichir l'écran
Application.ScreenUpdating = False
   
' Exécuter ce qui suit en boucle.
Do While Range("O3") = ""
   
    If Range("AB1") = "" Then
       
    Else
' 1) Copier les données de la plage O3:AI3 et les coller dans la cellule O1
        Range("O3:AI3").Select
        Selection.Copy
        Range("O1").Select
        ActiveSheet.Paste
       
' Créer le nom du pdf pour l'enregistrement : Le No du contrat et le nom du client
        mon_pdf = [N1]
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveWorkbook.Path & "\" & mon_pdf & " .pdf", Quality:=xlQualityStandard
        MonFichier = ActiveWorkbook.Path & "\" & mon_pdf & " .pdf"
       
'Imprimer le contrat
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
       
' Ne pas raffraichir l'écran.
        Application.ScreenUpdating = False
       
' Sélectionner le contrat suivant plage O3:AI3 puis couper les données vers O1:AI1
        Range("O3:AI3").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
       
' 1) Envoyer le contrat par courriel
        With OutMail
            .To = Range("AB1").Value ' Client
            .CC = Range("AL1").Value ' Déneigeur
            .BCC = Range("AM1").Value ' Moi
            .Subject = Range("N2").Value
            .HTMLBody = "<p>Bonjour,</p>" & "<p>Ci-joint, votre contrat de déneigement pour la saison en cour. " & "<br>" & "<p>Cordialement, " & "<br>" & "<p>" & "Kevin Trottier"
            .Attachments.Add MonFichier
            .Send
        End With
    End If
       
' Boucler jusqu'à ce que la cellule O3 soit vide
Loop
   
Range("C8").Select

' Enregistrer le classeur
ActiveWorkbook.Save
   
End Sub

*Il manquait un
==>end with
et
VB:
If Range("AB1") = "" Then
       
    Else
devrait être remplacé par

VB:
If Range("AB1") <> "" Then

*Mais étant invisible verra s tu mon post ? o_O

@Phil69970
 

Discussions similaires