Utilisation d'une boucle

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

barry white

XLDnaute Occasionnel
Bonjour,

J'ai une macro qui fait des actions en fonction du contennu d'un feuillet, je m explique

Feuille 1 : dans la colonne A j'ai des noms qui peut aller jusqu a la 21eme ligne et parfois elle peut aller jusqu a la 6eme lignes.

Ma macro se base sur cette FEUILLE/cellule pour traiter une autre feuille en fonction des ces informations.

Mais j'ai fais un peu le bourrin, c'est a dire dans mon code j'ai recoiper 21 fois la meme chose, en changant bien sur les numero de ligne a chaque fois.

Le probele quand j'ai que 6 lignes, il va encore executer 15 fois ma macro.

Donc comment faire pour que ma macro s'arrete au bon moment.
Merci à vous 🙂

mon code :


Dim rep As String
Dim Nom As String
Dim Nom1 As String
Dim init As String
Dim Extension As String
repertoire = ActiveWorkbook.Path & "\"
Nom = "MIS_CHRONO_"
Nom1 = Left(Mid(ActiveWorkbook.name, 12), Len(Mid(ActiveWorkbook.name, 12)) - 4)
init = Range("Table_Ressources_chronogramme!$F$2")
mail = Range("Table_Ressources_chronogramme!$D$2")
Extension = ".xls"


Range("E1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:=Range("Table_Ressources_chronogramme!C2")
Range("A1:I492").Select
Range("E1").Activate
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Run "PERSO.XLS!MIS_Mettre_en_forme_chrono"
Rows("4:4").EntireRow.AutoFit
Application.Run "PERSO.XLS!MIS_Proteger_saisie_figer_feuille_filtrer"
Range("C2").Select
ActiveWorkbook.SaveAs Filename:= _
repertoire & Nom & Nom1 & "_" & init & Extension _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWindow.Close
Range("G40").Select
Selection.AutoFilter

'Creation de l'objet e-mail
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olmailItem)
'Caractéristiques de l'e-mail
With olmail
.To = Range("Table_Ressources_chronogramme!$D$2")

'Affiche le nom comme objet du message
.Subject = "[ blabla]"
.Body = "bonjour "

'Pièces jointes si il y a lieu

repertoire = ActiveWorkbook.Path & "\"
Nom = "MIS_CHRONO_"
Nom1 = Left(Mid(ActiveWorkbook.name, 12), Len(Mid(ActiveWorkbook.name, 12)) - 4)
init = Range("Table_Ressources_chronogramme!$F$2")
Extension = ".xls"
.Attachments.Add _
repertoire & Nom & Nom1 & "_" & init & Extension _



End With
 
Trier par date Trier par votes
Re : Utilisation d'une boucle

Bonjour Barry WHITE,

Tu peux déjà simplifier la première partie de la façon suivante :

Code d'origine :
Code: 
Dim rep As String
Dim Nom As String
Dim Nom1 As String
Dim init As String
Dim Extension As String

Nouveau code voulant dire exactement la même chose :
Code: 
Dim rep, Nom, Nom1, init, Extension As String

Quelle partie répètes-tu 6 ou 21 fois???

Lorsqu'il faut répéter ton code que 6 fois, c'est parce que la cellule la plus basse de la colonne A est la 6ème? Si oui, utiliser le code indiqué ci-dessous en rouge.

Boucle que tu peux utiliser : For... To... Next

Code: 
Sub BarryWhite()

Dim i, NbDeFois as integer

[COLOR="Red"][B]NbDeFois = Sheets("Feuil1").Range("A65536").End(xlUp).Row[/B][/COLOR]

'partie de la macro à répéter qu'une fois

For i = 1 to NbDeFois

'partie de ta macro à répéter x fois

Next i

'partie de ta macro à répéter qu'une fois

End Sub

Si besoin d'une réponse plus précise, pose ta question plus précisement, le fichier simplifié serait l'idéal 😉

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Utilisation d'une boucle

Bonsoir


Excel-Lent '(bonsoir)
Sauf erreur de ma part

Dim rep, Nom, Nom1, init, Extension As String

déclare rep, Nom, Nom1, init en Variant et Seulement Extension en String

Là tout est déclaré en String
Dim rep$, Nom$, Nom1$, init$, Extension$


Barry White
Peux-tut utiliser les balises BB CODE pour rendre ton code plus lisible, stp.
Merci
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Utilisation d'une boucle

Oki j'arrive a faire la boucle mais maintenant j'arrive pas a faire varrier les valeurs en ROUGE

Code: 
Dim rep, Nom, Nom1, init, Extension As String
Dim i, nbf As Integer
    
    nbf = Sheets("Table_Ressources_chronogramme").Range("A65536").End(xlUp).Row
    
    
    For i = 1 To nbf
        
    
    repertoire = ActiveWorkbook.Path & "\"
    Nom = "MIS_CHRONO_"
    Nom1 = Left(Mid(ActiveWorkbook.name, 12), Len(Mid(ActiveWorkbook.name, 12)) - 4)
    init = Range("Table_Ressources_chronogramme!$F$[SIZE="6"][B][COLOR="Red"]2[/COLOR][/B][/SIZE]")
    date_jour = Format(Date + 1, "MM/DD/yyyy")
    Extension = ".xls"
    
        
    
    
    Range("E1").Select
    SELECTION.AutoFilter
    SELECTION.AutoFilter Field:=4, Criteria1:=Range("Table_Ressources_chronogramme!C[SIZE="6"][B][COLOR="Red"]2[/COLOR][/B][/SIZE]")
    SELECTION.AutoFilter Field:=7, Criteria1:="<100%", Operator:=xlAnd
    SELECTION.AutoFilter Field:=5, Criteria1:="<" & date_jour, Operator:=xlAnd
    Range("A1:I492").Select
    Range("E1").Activate
    SELECTION.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Run "PERSO.XLS!Mettre_en_forme_chrono"
    Rows("4:4").EntireRow.AutoFit
    
    Application.Run "PERSO.XLS!Proteger_saisie_figer_feuille_filtrer"
    Range("C[SIZE="6"][B][COLOR="Red"]2[/COLOR][/B][/SIZE").Select
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
    repertoire & Nom & Nom1 & "_" & init & Extension _
    , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    Application.DisplayAlerts = True

    ActiveWindow.Close
    Range("G40").Select
    SELECTION.AutoFilter
    
'Creation de l'objet e-mail
    Dim ol As New Outlook.Application
    Dim olmail As MailItem
    Dim CurrFile As String
    Set ol = New Outlook.Application
    Set olmail = ol.CreateItem(olmailItem)
'Caractéristiques de l'e-mail
    With olmail
    .To = Range("Table_Ressources_chronogramme!$D$[SIZE="6"][B][COLOR="Red"]2[/COLOR][/B][/SIZE]")
   
'Affiche le nom comme objet du message
    .Subject = "[MISTRAL]"
    .Body = "bonjour Project Mistral"

'Pièces jointes si il y a lieu
'attention le chemin est à changer pour ton besoin

    repertoire = ActiveWorkbook.Path & "\"
    Nom = "MIS_CHRONO_"
    Nom1 = Left(Mid(ActiveWorkbook.name, 12), Len(Mid(ActiveWorkbook.name, 12)) - 4)
    init = Range("Table_Ressources_chronogramme!$F$[SIZE="6"][B][COLOR="Red"]2[/COLOR][/B][/SIZE]")
    Extension = ".xls"
    .Attachments.Add _
    repertoire & Nom & Nom1 & "_" & init & Extension _


'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
.Display

End With

Next i

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Utilisation d'une boucle

J'ai trouvé!!! Voici le code


Code: 
MsgBox ("Merci de vérifier la bonne saisie des intervenants dans la table des ressources (Pas de caractère spéciaux)")
    
    
'integration des variables
  
    Dim rep, Nom, Nom1, init, Extension, CurrFile As String
    Dim ti, mail, n As Variant
    Dim i, nbf As Integer
    Dim ol As New Outlook.Application
    Dim olmail As MailItem

'Variable de nb Boucle
    
    nbf = Sheets("Table_Ressources_chronogramme").Range("A65536").End(xlUp).Row
   
'Initialisation de la boucle

    For i = 2 To nbf
        
'Variable nom
    n = Sheets("Table_Ressources_chronogramme").Range("C" & i).Value
 
'Variable initiale
    ti = Sheets("Table_Ressources_chronogramme").Range("f" & i).Value
    
'Variable mail
    mail = Sheets("Table_Ressources_chronogramme").Range("D" & i).Value
    
'Selection table_taches_chronogramme
    Sheets("Table_Taches_chronogramme").Select
    
    
'Variable enregistrement du nom de fichier
    repertoire = ActiveWorkbook.Path & "\"
    Nom = "MIS_CHRONO_"
    Nom1 = Left(Mid(ActiveWorkbook.name, 22), Len(Mid(ActiveWorkbook.name, 32)) - 4)
    init = (ti)
    date_jour = Format(Date + 1, "MM/DD/yyyy")
    Extension = ".xls"
        
'Filtre sur le Nom de la ressource, a la date du jour +1 et tache d'avancement inferieur a 100%
    Range("E1").Select
    SELECTION.AutoFilter
    SELECTION.AutoFilter Field:=4, Criteria1:=(n)
    SELECTION.AutoFilter Field:=7, Criteria1:="<100%", Operator:=xlAnd
    SELECTION.AutoFilter Field:=5, Criteria1:="<" & date_jour, Operator:=xlAnd
    Range("A1:I492").Select
    Range("E1").Activate
    SELECTION.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Run "PERSO.XLS!Mettre_en_forme_chrono"
    Rows("4:4").EntireRow.AutoFit
    
    Application.Run "PERSO.XLS!Proteger_saisie_figer_feuille_filtrer"
    Range("C2").Select
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
    repertoire & Nom & Nom1 & "_" & init & Extension _
    , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    Application.DisplayAlerts = True

    ActiveWindow.Close
    Range("G40").Select
    SELECTION.AutoFilter
    
'Creation de l'objet e-mail
    Set ol = New Outlook.Application
    Set olmail = ol.CreateItem(olmailItem)
'Caractéristiques de l'e-mail
    With olmail
    .To = (mail)
   
'Affiche le nom comme objet du message
    .Subject = "[MISTRAL]"
    .Body = "bonjour Project Mistral"

'Pièces jointes si il y a lieu
'attention le chemin est à changer pour ton besoin

    repertoire = ActiveWorkbook.Path & "\"
    Nom = "MIS_CHRONO_"
    Nom1 = Left(Mid(ActiveWorkbook.name, 22), Len(Mid(ActiveWorkbook.name, 32)) - 4)
    init = (ti)
    Extension = ".xls"
    .Attachments.Add _
    repertoire & Nom & Nom1 & "_" & init & Extension _

'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
.Display

End With

Next i

End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Cliquer pour ouvrir des photos
Réponses
7
Affichages
817
Simon 1234
S
N
  • Question Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
727
Phil69970
Phil69970
S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
546
Phil69970
Phil69970
chris6999
  • Question Question
Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne
Réponses
5
Affichages
657
patricktoulon
patricktoulon
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
661
ph.vanne
ph.vanne
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
604
patricktoulon
patricktoulon
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
573
JJ69
J
M
  • Question Question
Microsoft 365 macro en fct de l'état d'une autre (boucle)
Réponses
3
Affichages
257
sylvanu
sylvanu
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
978
oguruma
oguruma
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
551
spike29
S
pmfontaine
  • Question Question
Microsoft 365 Erreur d'exécution 5 argument ou appel de procédure incorrect avec ActiveSheet.ChartObjects.Add()
Réponses
12
Affichages
830
pmfontaine
pmfontaine
halecs93
  • Question Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
931
halecs93
halecs93
Cédric06400
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
586
Franc58
F
N
  • Résolu(e)
Microsoft 365 Modification impossible d'une TextBox
2 3 4
Réponses
56
Affichages
2 K
NONO14
N
J
  • Résolu(e)
XL 2013 Macro et script vba : macro s'arrête dès la première condition trouvée
Réponses
11
Affichages
1 K
Janu44
J
K
  • Résolu(e)
XL 2019 Probleme codage
Réponses
2
Affichages
478
Kevin42560
K
T
  • Question Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
813
M@xu3L
M
piga25
  • Résolu(e)
XL 2016 Gestion d'erreur dans code
Réponses
6
Affichages
650
piga25
piga25
Q
  • Résolu(e)
Microsoft 365 Exécutions directes différentes vs "pas à pas"
Réponses
2
Affichages
605
Quentin2106
Q
Retour