Microsoft 365 Boucle Do until

danpom302 · 20 Septembre 2021

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

Phil69970 · 22 Septembre 2021

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...

Phil69970 · 20 Septembre 2021

Bonjour

Ton "end if" n'est pas au bon endroit

Tu as ecris

VB:

Do while

    If ...

    else

Loop


end if

Il faut ecrire

VB:

Do while

    If ...

    else

    end if

Loop

*Merci de ton retour

@Phil69970

sylvanu · 20 Septembre 2021

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 !

Hasco · 20 Septembre 2021

Bonjour,

Vos if et while sont mal imbriqués de plus il vous manque un End With :
La séquence normale devrait être

Do While

If

Else

With

End With

End if

Loop

Cordialement

danpom302 · 20 Septembre 2021

Hasco à dit:
Bonjour,

Vos if et while sont mal imbriqués de plus il vous manque un End With :
La séquence normale devrait être

Do While

If
Else
With
End With
End if
Loop

Cordialement

Merci. J'essai de corriger. Dan

Hasco · 20 Septembre 2021

Re bonjour,

Lisez toutes les réponses qui vous sont données. Je crois que vous avez oublié @sylvanu

Cordialement

danpom302 · 21 Septembre 2021

sylvanu à dit:
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

Phil69970 · 21 Septembre 2021

Re

Apparemment mon post est transparent !

@Phil69970

danpom302 · 21 Septembre 2021

Merci, j'essai de corriger et je vous reviens demain.

danpom302 · 22 Septembre 2021

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 · 22 Septembre 2021

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 ?

@Phil69970

danpom302 · 22 Septembre 2021

Merci, ça fonctionne maintenant. Bravo !

Phil69970 · 22 Septembre 2021

Re

@danpom302 :
Décidément c'est pas mon jour .... quand ça veut pas ça veut pas ......
La logique est de mettre en résolu le post qui ta apporté la solution et non la tienne qui ne t'as rien apportè puisque tu ne connaissais pas la solution !!!

@Phil69970

danpom302 · 22 Septembre 2021

Première fois sur ce site. Désolé. Là, est-ce mieux ainsi ? Dan

Phil69970 · 22 Septembre 2021

Re

C'est pas la question d'être mieux ou pas mais la logique est que les futurs lecteurs puissent voir la solution qui pour toi correspond à la question que tu as posé, ce qui permet d'aller directement à la solution sans être obligé de lire 14 messages....

@Phil69970

Microsoft 365 Boucle Do until

danpom302

XLDnaute Nouveau

Phil69970

Phil69970

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Hasco

XLDnaute Barbatruc

danpom302

XLDnaute Nouveau

Hasco

XLDnaute Barbatruc

danpom302

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

danpom302

XLDnaute Nouveau

danpom302

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

danpom302

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

danpom302

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Discussions similaires