Bonjour
j'ai 2 macros que je voudrais lancer en 1 seule fois.(ordre execution :
macro1 puis macro2)
Je n'arrive pas à écrire pour en avoir une seule et que cela fonctionne
Pouvez vous m'aider? Merci d'avance
Macro 1 : Calendrier + Macro 2 : Repartition
pour devenir Macro 3 : CalendrierRepart
voici les textes
---------------
Macro1 : Sub Calendrier()
Range("A:A").ClearContents
Range("B:B").ClearContents
' construit un calendrier dans une colonne
' choix de la cellule de départ par l'utilisateur
' choix des dates de début et fin de calendrier
Dim deb#, fin#, NbJours&, i As Date
Dim cell As Range, Li&, Col%
On Error Resume Next
deb = CDate(InputBox("Première date du calendrier - Format : jj/mm/aaaa
"))
fin = CDate(InputBox("Dernière date du calendrier - Format : jj/mm/aaaa
"))
If Err <> 0 Then Exit Sub
Set cell = Sheets("Feuil2").Range("A1")
Li = cell.Row: Col = cell.Column
For i = deb To fin
Cells(Li, Col).Value2 = i
' If Weekday(i, vbMonday) > 5 Then _
Cells(Li, Col).Interior.ColorIndex = 0
' pour surligner les samedis, dimanches et fériés
If TYPEJOUR(i) = 1 Or TYPEJOUR(i) = 2 Then _
Cells(Li, Col).Interior.ColorIndex = 0
Cells(Li, Col).NumberFormatLocal = "jjjj jj/mm/aaaa"
Li = Li + 1
Next i
End Sub
-------------------
Macro2 : Sub Repartition()
Dim c As Range, nb, i
nb = [lesNoms].Count
'au cas où i = -1 ou i= 0
On Error Resume Next
For Each c In [lesDates]
'au cas où des cellules de la plage lesDates sont vides
' ou ne sont pas des dates valides
If Not IsDate(c) Then GoTo suite
If i = nb Then i = 0
' au cas où les dates comportent les samedi/dimanche
If Weekday(c, 2) > 5 Then GoTo suite
i = i + 1
' au cas où des cellules de la plage lesNoms sont vides
Do Until [lesNoms].Item(i) <> ""
i = i + 1
If i > nb Then i = -1
Loop
c.Offset(0, 1) = [lesNoms].Item(i)
suite:
Next c
End Sub
--------------------------------------
Cordialement
Patrice C
pour m'écrire enlever "spammeuroubliezmoi_"
Rebonjour Quand on est mauvais.... ça fonctionne bien. Le probleme venait de ma plage "lesnoms" qui était mal confirgurée Merci encore -- Cordialement Patrice C pour m'écrire enlever "spammeuroubliezmoi_"
"Patrice C." a écrit dans le message de news:%23ULT%
Bonjour Merci pour ta proposition mais désolé la 2eme ne demarre pas -- Cordialement Patrice C pour m'écrire enlever "spammeuroubliezmoi_"
"Nicolas B." a écrit dans le message de news:OQAt%
Salut Patrice,
Colle cette macro à la suite des deux autres :
sub CalendrierRepart() Calendrier Repartition end sub
A+ -- Nicolas B.
Bonjour j'ai 2 macros que je voudrais lancer en 1 seule fois.(ordre execution : macro1 puis macro2) Je n'arrive pas à écrire pour en avoir une seule et que cela fonctionne Pouvez vous m'aider? Merci d'avance Macro 1 : Calendrier + Macro 2 : Repartition pour devenir Macro 3 : CalendrierRepart voici les textes --------------- Macro1 : Sub Calendrier() Range("A:A").ClearContents Range("B:B").ClearContents ' construit un calendrier dans une colonne ' choix de la cellule de départ par l'utilisateur ' choix des dates de début et fin de calendrier Dim deb#, fin#, NbJours&, i As Date Dim cell As Range, Li&, Col% On Error Resume Next deb = CDate(InputBox("Première date du calendrier - Format : jj/mm/aaaa ")) fin = CDate(InputBox("Dernière date du calendrier - Format : jj/mm/aaaa ")) If Err <> 0 Then Exit Sub Set cell = Sheets("Feuil2").Range("A1") Li = cell.Row: Col = cell.Column For i = deb To fin Cells(Li, Col).Value2 = i ' If Weekday(i, vbMonday) > 5 Then _ Cells(Li, Col).Interior.ColorIndex = 0 ' pour surligner les samedis, dimanches et fériés If TYPEJOUR(i) = 1 Or TYPEJOUR(i) = 2 Then _ Cells(Li, Col).Interior.ColorIndex = 0 Cells(Li, Col).NumberFormatLocal = "jjjj jj/mm/aaaa" Li = Li + 1 Next i End Sub ------------------- Macro2 : Sub Repartition() Dim c As Range, nb, i nb = [lesNoms].Count 'au cas où i = -1 ou i= 0 On Error Resume Next For Each c In [lesDates] 'au cas où des cellules de la plage lesDates sont vides ' ou ne sont pas des dates valides If Not IsDate(c) Then GoTo suite If i = nb Then i = 0 ' au cas où les dates comportent les samedi/dimanche If Weekday(c, 2) > 5 Then GoTo suite i = i + 1 ' au cas où des cellules de la plage lesNoms sont vides Do Until [lesNoms].Item(i) <> "" i = i + 1 If i > nb Then i = -1 Loop c.Offset(0, 1) = [lesNoms].Item(i) suite: Next c End Sub --------------------------------------
Cordialement Patrice C pour m'écrire enlever "spammeuroubliezmoi_"
Rebonjour
Quand on est mauvais....
ça fonctionne bien. Le probleme venait de ma plage "lesnoms" qui était mal
confirgurée
Merci encore
--
Cordialement
Patrice C
pour m'écrire enlever "spammeuroubliezmoi_"
"Patrice C." <spammeuroubliezmoi_pat.cas@free.fr> a écrit dans le message de
news:%23ULT%23ovGEHA.3288@TK2MSFTNGP12.phx.gbl...
Bonjour
Merci pour ta proposition
mais désolé la 2eme ne demarre pas
--
Cordialement
Patrice C
pour m'écrire enlever "spammeuroubliezmoi_"
"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le message de
news:OQAt%23muGEHA.3064@tk2msftngp13.phx.gbl...
Salut Patrice,
Colle cette macro à la suite des deux autres :
sub CalendrierRepart()
Calendrier
Repartition
end sub
A+
--
Nicolas B.
Bonjour
j'ai 2 macros que je voudrais lancer en 1 seule fois.(ordre execution
: macro1 puis macro2)
Je n'arrive pas à écrire pour en avoir une seule et que cela
fonctionne Pouvez vous m'aider? Merci d'avance
Macro 1 : Calendrier + Macro 2 : Repartition
pour devenir Macro 3 : CalendrierRepart
voici les textes
---------------
Macro1 : Sub Calendrier()
Range("A:A").ClearContents
Range("B:B").ClearContents
' construit un calendrier dans une colonne
' choix de la cellule de départ par l'utilisateur
' choix des dates de début et fin de calendrier
Dim deb#, fin#, NbJours&, i As Date
Dim cell As Range, Li&, Col%
On Error Resume Next
deb = CDate(InputBox("Première date du calendrier - Format :
jj/mm/aaaa "))
fin = CDate(InputBox("Dernière date du calendrier - Format :
jj/mm/aaaa "))
If Err <> 0 Then Exit Sub
Set cell = Sheets("Feuil2").Range("A1")
Li = cell.Row: Col = cell.Column
For i = deb To fin
Cells(Li, Col).Value2 = i
' If Weekday(i, vbMonday) > 5 Then _
Cells(Li, Col).Interior.ColorIndex = 0
' pour surligner les samedis, dimanches et fériés
If TYPEJOUR(i) = 1 Or TYPEJOUR(i) = 2 Then _
Cells(Li, Col).Interior.ColorIndex = 0
Cells(Li, Col).NumberFormatLocal = "jjjj jj/mm/aaaa"
Li = Li + 1
Next i
End Sub
-------------------
Macro2 : Sub Repartition()
Dim c As Range, nb, i
nb = [lesNoms].Count
'au cas où i = -1 ou i= 0
On Error Resume Next
For Each c In [lesDates]
'au cas où des cellules de la plage lesDates sont vides
' ou ne sont pas des dates valides
If Not IsDate(c) Then GoTo suite
If i = nb Then i = 0
' au cas où les dates comportent les samedi/dimanche
If Weekday(c, 2) > 5 Then GoTo suite
i = i + 1
' au cas où des cellules de la plage lesNoms sont vides
Do Until [lesNoms].Item(i) <> ""
i = i + 1
If i > nb Then i = -1
Loop
c.Offset(0, 1) = [lesNoms].Item(i)
suite:
Next c
End Sub
--------------------------------------
Cordialement
Patrice C
pour m'écrire enlever "spammeuroubliezmoi_"
Rebonjour Quand on est mauvais.... ça fonctionne bien. Le probleme venait de ma plage "lesnoms" qui était mal confirgurée Merci encore -- Cordialement Patrice C pour m'écrire enlever "spammeuroubliezmoi_"
"Patrice C." a écrit dans le message de news:%23ULT%
Bonjour Merci pour ta proposition mais désolé la 2eme ne demarre pas -- Cordialement Patrice C pour m'écrire enlever "spammeuroubliezmoi_"
"Nicolas B." a écrit dans le message de news:OQAt%
Salut Patrice,
Colle cette macro à la suite des deux autres :
sub CalendrierRepart() Calendrier Repartition end sub
A+ -- Nicolas B.
Bonjour j'ai 2 macros que je voudrais lancer en 1 seule fois.(ordre execution : macro1 puis macro2) Je n'arrive pas à écrire pour en avoir une seule et que cela fonctionne Pouvez vous m'aider? Merci d'avance Macro 1 : Calendrier + Macro 2 : Repartition pour devenir Macro 3 : CalendrierRepart voici les textes --------------- Macro1 : Sub Calendrier() Range("A:A").ClearContents Range("B:B").ClearContents ' construit un calendrier dans une colonne ' choix de la cellule de départ par l'utilisateur ' choix des dates de début et fin de calendrier Dim deb#, fin#, NbJours&, i As Date Dim cell As Range, Li&, Col% On Error Resume Next deb = CDate(InputBox("Première date du calendrier - Format : jj/mm/aaaa ")) fin = CDate(InputBox("Dernière date du calendrier - Format : jj/mm/aaaa ")) If Err <> 0 Then Exit Sub Set cell = Sheets("Feuil2").Range("A1") Li = cell.Row: Col = cell.Column For i = deb To fin Cells(Li, Col).Value2 = i ' If Weekday(i, vbMonday) > 5 Then _ Cells(Li, Col).Interior.ColorIndex = 0 ' pour surligner les samedis, dimanches et fériés If TYPEJOUR(i) = 1 Or TYPEJOUR(i) = 2 Then _ Cells(Li, Col).Interior.ColorIndex = 0 Cells(Li, Col).NumberFormatLocal = "jjjj jj/mm/aaaa" Li = Li + 1 Next i End Sub ------------------- Macro2 : Sub Repartition() Dim c As Range, nb, i nb = [lesNoms].Count 'au cas où i = -1 ou i= 0 On Error Resume Next For Each c In [lesDates] 'au cas où des cellules de la plage lesDates sont vides ' ou ne sont pas des dates valides If Not IsDate(c) Then GoTo suite If i = nb Then i = 0 ' au cas où les dates comportent les samedi/dimanche If Weekday(c, 2) > 5 Then GoTo suite i = i + 1 ' au cas où des cellules de la plage lesNoms sont vides Do Until [lesNoms].Item(i) <> "" i = i + 1 If i > nb Then i = -1 Loop c.Offset(0, 1) = [lesNoms].Item(i) suite: Next c End Sub --------------------------------------
Cordialement Patrice C pour m'écrire enlever "spammeuroubliezmoi_"
