Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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...
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…