Do...Loop Until ou Do Until...Loop

[cibleo]

Bonsoir le forum 🙂

Voilà, j'ai vraiment beaucoup de mal à me familiariser avec ces boucles.

Je cherche à affecter ma variable DebJournee avec la 1ère cellule non vide de la ligne concernée (ici la 5)

J'ai donc pensé à utiliser une boucle jusqu'à.

Mais cela ne fonctionne pas avec la ligne 5, alors que cela marche ave la ligne 6 ou 7 par exemple. 😕

D'ailleurs, je ne comprends pas la nuance du test placé en début ou fin de boucle.

Sub DebutJournee()
Dim DebJournee As String, j As Long
j = 2
  Do
    DebJournee = Cells([COLOR=red]5[/COLOR], j)
    j = j + 1
  Loop Until Cells([COLOR=red]5[/COLOR], j) <> ""
End Sub

De plus, j'aimerais compléter le code d'une condition : si toutes les cellules des colonnes B à L de la ligne concernée sont vides alors la variable DebJournee doit contenir "Aucune course à effectuer pour le moment"

Je vous joins un fichier pour exemple.

Le code est placé dans le module de la feuille.

Pouvez-vous me venir en aide ?

Cibleo

 

[pierrejean]

Re : Do...Loop Until ou Do Until...Loop

bonjour cibleo

Je te propose

Function DebJournee(ligne) As String
Dim j As Long
j = 1
  Do
    j = j + 1
  Loop Until Cells(ligne, j) <> "" Or j = 12
  If j = 12 Then
    DebJournee = "Aucune course à effectuer pour le moment"
  Else
    DebJournee = Cells(ligne, j)
  End If
End Function

Sub test()
MsgBox (DebJournee(10))
End Sub

 

[Robert]

Re : Do...Loop Until ou Do Until...Loop

Bosoir Cibleo, bonsoir le forum,

Peut-être comme ça :

Sub DebutJournee()
Dim DebJournee As String, j As Long
 
For j = 2 To 12
If Cells(5, j) <> "" Then
    DebJournee = Cells(5, j)
    Exit Sub
End If
MsgBox "Aucune course à effectuer pour le moment"
End Sub

Édition :

Bonsoir PierreJean on sé st croisé.

 

[cibleo]

Re : Do...Loop Until ou Do Until...Loop

Bonsoir Robert, PierreJean 🙂

Robert, ton code fonctionne mais cela ne répond pas tout à fait à ma demande.

Je cherche en effet à trouver la 1ère cellule pleine pour affecter ma variable puis m'arrêter.

Dans ton cas, il me signale les cellules vides qui précèdent la 1ère cellule pleine puis la dite cellule.

Par contre le code de Pierrejean fonctionne à merveille, c'est exactement çà.

Je vais essayer d'intégrer la solution de pierrejean à mon fichier original,
Si problème, je reviens avec mon fichier et des explications.

Bonsoir à tous et merci à tous les 2.

A+ Cibleo

 

[Robert]

Re : Do...Loop Until ou Do Until...Loop

Bonsoir le fil, bonsoir le forum,

Tu as raison Cibleo il manquait un NEXT à mon code pour qu'il fonctionne correctement. Désolé.

Le bon code :

Sub DebutJournee()
Dim DebJournee As String, j As Long
 
For j = 2 To 12
    If Cells(5, j) <> "" Then
        DebJournee = Cells(5, j)
        Exit Sub
    End If
Next
MsgBox "Aucune course à effectuer pour le moment"
End Sub

 

[cibleo]

Re : Do...Loop Until ou Do Until...Loop

Bonsoir le forum, Pierrejean, Robert

Je reviens pour intégrer le code de PierreJean dans la macro ci-dessous.
C'est le bloc With Activesheet surligné en bleu qui me pose problème.

Dans la boucle For Each, la variable Prenom est bien affecté avec les prénoms figurant en colonne B (Feuille : MesDestinataires).

On retrouve les mêmes prénoms en colonne A dans l'autre feuille (le planning soit l'ActiveSheet)

Dans la composition du message, j'aimerais donc que la variable DebJournee soit bien affectée par rapport à la variable Prenom.

J'ai bien essayé ceci, mais cela ne fonctionne pas 🙁

Loop Until Cells([B][COLOR=red]lig[/COLOR][/B], j) <> "" Or j = 12

Sub EnvoyerMailEtPDF()
'Dim objMessage As Object
Dim objMessage As CDO.Message
Dim sNomPDF As String, sCheminPDF As String
Dim [COLOR=green]Prenom[/COLOR] As String, AdresMail As String, Msg As String, [COLOR=red]DebJournee[/COLOR] As String
Dim DCarteVal As Date, j As Long, c As Range, lig As Long
'---- Création et envoi message ------------
[B]For Each cell In Sheets("MesDestinataires").Range("D2:D8").SpecialCells(xlCellTypeConstants)[/B]
    If cell.Value Like "*@*" And cell.Offset(0, -3).Value = "x" Then
       [COLOR=green]Prenom[/COLOR] = cell.Offset(0, -2).Value
        DCarteVal = cell.Offset(0, -1).Value
        AdresMail = cell.Value
 
        [COLOR=blue]With ActiveSheet[/COLOR]
[COLOR=blue]'Set c = Range("A4:A11").Find(What:=[COLOR=green]Prenom[/COLOR], Lookat:=xlWhole)[/COLOR]
[COLOR=blue]'lig = c.Address[/COLOR]
[COLOR=blue]'lig = Range(lig).Row[/COLOR]
[COLOR=blue]j = 1[/COLOR]
[COLOR=blue]Do[/COLOR]
[COLOR=blue]j = j + 1[/COLOR]
[COLOR=blue]Loop Until Cells(10, j) <> "" Or j = 12[/COLOR]
[COLOR=blue]If j = 12 Then[/COLOR]
[COLOR=blue][COLOR=red]DebJournee[/COLOR] = "Aucune course à effectuer pour le moment"[/COLOR]
[COLOR=blue]Else[/COLOR]
[COLOR=blue][COLOR=red]DebJournee[/COLOR] = Cells(10, j)[/COLOR]
[COLOR=blue]End If[/COLOR]
[COLOR=blue]End With[/COLOR]
 
        'Composer le message
        Msg = "Bonjour " & Prenom & ","
        Msg = Msg & vbCrLf & vbCrLf & "Tu trouveras ci-joint le planning du jour." & vbCrLf
        Msg = Msg & "Ta journée débute ainsi : " & vbCrLf & vbCrLf & [COLOR=red]DebJournee[/COLOR] & vbCrLf & vbCrLf
        Msg = Msg & "Cordialement Cibleo"
 
        Set objMessage = New CDO.Message
        'Set objMessage = CreateObject("CDO.Message")
        With objMessage
            .Subject = "Envoi Planning du jour à " & Prenom ' Sujet du mail
            .From = "zozo[EMAIL="t@wanadoo.fr"]@wanadoo.fr[/EMAIL]"
            .To = AdresMail
            .TextBody = Msg
            '.AddAttachment sCheminPDF & sNomPDF ' Fichier joint au mail
            .Send '<<<<<<<<<<<<<<<Pour envoyer directement
        End With
    Set objMessage = Nothing
    End If
[B]Next cell[/B]
End Sub

Pouvez-vous intervenir une nouvelle fois ?

Cibleo

 

[cibleo]

Re : Do...Loop Until ou Do Until...Loop

Bonsoir le forum,

Voilà, j'ai trouvé 🙂

.../...
With ActiveSheet
        Set c = Range("A4:A11").Find(What:=[COLOR=green]Prenom[/COLOR], Lookat:=xlWhole)
        [COLOR=blue]lig[/COLOR] = c.Row
 
        j = 1
        Do
            j = j + 1
        Loop Until Cells([COLOR=blue]lig[/COLOR], j) <> "" Or j = 12
        If j = 12 Then
            [COLOR=red]DebJournee[/COLOR] = "Tu n'as aucune course à effectuer pour le moment."
        Else
            [COLOR=red]DebJournee[/COLOR] = "Ta journée débute ainsi : " & vbCrLf & vbCrLf & Cells([COLOR=blue]lig[/COLOR], j)
        End If
End With
 
        'Composer le message
        Msg = "Bonjour " & [COLOR=green]Prenom[/COLOR] & ","
        Msg = Msg & vbCrLf & vbCrLf & "Tu trouveras ci-joint le planning du jour." & vbCrLf
        Msg = Msg & [COLOR=red]DebJournee[/COLOR] & vbCrLf & vbCrLf
.../...
End Sub

Merci à tous.

A bientôt Cibleo 😉