VBA : boucle pour incrémenter les 7 jours de la semaine

cibleo

XLDnaute Impliqué
Bonsoir le forum,

Dans le module1, j'ai repris un code de job75 qui me permait de dupliquer 53 feuilles (semaines de 2011) en nommant chaque onglet et en y insérant un titre en B1.

Dans la plage (A4:A10) de chaque feuille dupliquée, j'aimerais y ajouter les 7 dates correspondantes du Lundi au dimanche.
Code:
Sub FeuillesSemaines1()
Dim deb As Long, fin As Long, i As Long, n As Byte, tablo(1 To 53, 1 To 2), sem As Byte, nom As String, nom1 As String
deb = DateSerial(2010, 12, 27) 'du Lundi 27 décembre 2010
fin = DateSerial(2012, 1, 1)   'au Dimanche 01 janvier 2012 soit 53 semaines
For i = deb To fin
  If i = deb Or Weekday(i) = 2 Then n = n + 1: tablo(n, 1) = Format(i, "dd mmm yy")
  If i = Date Then sem = n
  If i = fin Or Weekday(i) = 1 Then tablo(n, 2) = Format(i, "dd mmm yy")
Next
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To n
  nom = "Semaine " & tablo(i, 1) & " - " & tablo(i, 2)
  nom1 = "Semaine du " & Format(tablo(i, 1), "dddd dd mmmm yyyy") & " au " & Format(tablo(i, 2), "dddd dd mmmm yyyy")
  nom = Sheets(nom).Name
  If Err Then
    Err = 0
    Sheets("Modele").Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = nom
    Sheets(Sheets.Count).[B1] = nom1
  End If
Next
Sheets("Semaine " & tablo(sem, 1) & " - " & tablo(sem, 2)).Select 'semaine en cours
End Sub
Dans le bloc If Err Then, j'ai voulu rajouter ceci :

Code:
.../...
With ActiveSheet
   For Lig = 4 To 10
    .Cells(Lig, 1) = tablo(i, 1)
   Next Lig
'End With
.../...

Mais bon, l'incrémentation des jours ne s'effectuent pas :(
Décidemment, j'ai une aversion pour les variables tableau.

Merci de votre aide Cibleo
 

Pièces jointes

  • Semaines2011bis.xls
    20 KB · Affichages: 105
  • Semaines2011bis.xls
    20 KB · Affichages: 111
  • Semaines2011bis.xls
    20 KB · Affichages: 111
Dernière édition:

JCGL

XLDnaute Barbatruc
Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Bonjour à tous,

Dans ta feuille "Modèle" tu rajoutes en A5 : =A4+1 et tu tires jusqu'en A10

Tu rajoutes cette ligne dans le code :

Sheets(Sheets.Count).[A4] = Tablo(i, 1)


If Err Then
Err = 0
Sheets("Modele").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Nom
Sheets(Sheets.Count).[A4] = Tablo(i, 1)
Sheets(Sheets.Count).[B1] = Nom1
End If

A+ à tous
 

cibleo

XLDnaute Impliqué
Bonsoir JCGL et merci pour ta réponse.

Dans la feuille "Modele", A4:A10 est formaté comme ceci : jjj jj mmm aa
Le format renvoyé doit donc correspondre à ceci : Lun 27 déc 10
Or j'obtiens visuellement ce format : 27 déc 10 dans toutes les cellules A4 des feuilles dupliquées.

Par contre A5:A10 renvoie le bon format.
Les cellules A4:A10 des feuilles dupliquées ont pourtant le format jjj jj mmm aa
Comprend pas :(

Y a pas un autre moyen que de passer par une formule dans la feuille "Modele"

Cibleo
 

JCGL

XLDnaute Barbatruc
Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Bonjour à tous,

Peux-tu essayer avec le code de Job, :):), très légèrement modifié:

VB:
Sub FeuillesSemaines()
    Dim Deb As Long, Fin As Long, i As Long, n As Byte, Tablo(1 To 53, 1 To 2), Sem As Byte, Nom As String, Nom1 As String

    Deb = DateSerial(2010, 12, 27)    'du Lundi 27 décembre 2010
    Fin = DateSerial(2012, 1, 1)   'au Dimanche 25 décembre 2011 soit 52 semaines
    For i = Deb To Fin
        If i = Deb Or Weekday(i) = 2 Then n = n + 1: Tablo(n, 1) = Format(i, "dd mmm yy")
        If i = Date Then Sem = n
        If i = Fin Or Weekday(i) = 1 Then Tablo(n, 2) = Format(i, "dd mmm yy")
    Next

    Application.ScreenUpdating = False
    On Error Resume Next
    For i = 1 To n
        Nom = "Semaine " & Tablo(i, 1) & " - " & Tablo(i, 2)
        Nom1 = "Semaine du " & Format(Tablo(i, 1), "dddd dd mmmm yyyy") & " au " & Format(Tablo(i, 2), "dddd dd mmmm yyyy")
        Nom = Sheets(Nom).Name
        If Err Then
            Err = 0
            Sheets("Modele").Copy after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Nom
            Sheets(Sheets.Count).[A4] = Format(Deb, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A5] = Format(Deb + 1, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A6] = Format(Deb + 2, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A7] = Format(Deb + 3, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A8] = Format(Deb + 4, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A9] = Format(Deb + 5, "ddd dd mmm yy")
            Sheets(Sheets.Count).[A10] = Format(Deb + 6, "ddd dd mmm yy")
            Sheets(Sheets.Count).[B1] = Nom1
        End If
        Deb = Deb + 7
    Next
    Sheets("Semaine " & Tablo(Sem, 1) & " - " & Tablo(Sem, 2)).Select    'semaine en cours
End Sub

A+ à tous
 

cibleo

XLDnaute Impliqué
Re: Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Bonjour à tous,
Bonjour JCGL,

Je reviens et j'avance doucement :
Au code initial, j'ai rajouté une variable tableau à 2 dimensions qui stocke les 371 dates (53 semaines de 7 jours)
Dim tablo1(1 To 53, 1 To 7)
et rajouter la boucle For y ci-dessous.

Code:
Sub FeuillesSemaines1()
Dim deb As Long, fin As Long, i As Long, n As Byte, tablo(1 To 53, 1 To 2), sem As Byte, nom As String, nom1 As String
Dim tablo1(1 To 53, 1 To 7), x As Integer, y As Byte, k As Byte, j As Byte
deb = DateSerial(2010, 12, 27) 'du Lundi 27 décembre 2010
fin = DateSerial(2012, 1, 1)   'au Dimanche 01 janvier 2012 soit 53 semaines
For y = 1 To 53
  For k = 1 To 7
    tablo1(y, k) = Format(deb + x, "ddd dd mmm yy")
    x = x + 1
  Next k
Next y
For i = deb To fin
  If i = deb Or Weekday(i) = 2 Then n = n + 1: tablo(n, 1) = Format(i, "dd mmm yy")
  If i = Date Then sem = n
  If i = fin Or Weekday(i) = 1 Then tablo(n, 2) = Format(i, "dd mmm yy")
Next
.../...

Puis cette instruction dans la condition If Err Then ...

Code:
Sheets(Sheets.Count).[A4:A10] = WorksheetFunction.Transpose(tablo1(i, 1))

Exécuter la macro et voyez le résultat, c'est presque que ça.
Un dernier coup de pouce
Merci Cibleo

Edit : pas vu ta réponse JCGL, je vois ça.
 

Pièces jointes

  • Semaines2011bis.xls
    20.5 KB · Affichages: 110
  • Semaines2011bis.xls
    20.5 KB · Affichages: 122
  • Semaines2011bis.xls
    20.5 KB · Affichages: 123

cibleo

XLDnaute Impliqué
Re: Re : VBA : boucle pour incrémenter les 7 jours de la semaine

Génial JCGL :):)

Le résultat est obtenu, je décrypte à coups de F8.

Par contre, si quelqu'un pouvait intervenir pour compléter mon code du post #5#, cela me permettrait de progresser sur les variables tableau.
J'ai d'énormes lacunes dans ce domaine et c'est surtout pour ne pas rester sur un goût d'inachevé.

Au plaisir JCGL
Merci Cibleo

Pour votre info, le code initial de Job75 ici :
https://www.excel-downloads.com/threads/inserer-feuilles-et-nommer-automatiquement.128392/
 
Dernière édition:

cibleo

XLDnaute Impliqué
Bonjour à tous,
Bonjour JCGL,

Voici ma version moins épurée :rolleyes:

VB:
Sub FeuillesSemaines1()
Dim Deb As Long, Fin As Long, i As Long, n As Byte, Tablo(1 To 53, 1 To 2), Sem As Byte, Nom As String, Nom1 As String
Dim tablo1(1 To 53, 1 To 7), x As Integer, y As Byte, k As Byte, j As Byte, Lig As Byte
Deb = DateSerial(2010, 12, 27) 'du Lundi 27 décembre 2010
Fin = DateSerial(2012, 1, 1) 'au Dimanche 01 janvier 2012 soit 53 semaines
For y = 1 To 53
For k = 1 To 7
tablo1(y, k) = Format(Deb + x, "ddd dd mmm yy")
x = x + 1
Next k
Next y
For i = Deb To Fin
If i = Deb Or Weekday(i) = 2 Then n = n + 1: Tablo(n, 1) = Format(i, "dd mmm yy")
If i = Date Then Sem = n
If i = Fin Or Weekday(i) = 1 Then Tablo(n, 2) = Format(i, "dd mmm yy")
Next
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To n
Nom = "Semaine " & Tablo(i, 1) & " - " & Tablo(i, 2)
Nom1 = "Semaine du " & Format(Tablo(i, 1), "dddd dd mmmm yyyy") & " au " & Format(Tablo(i, 2), "dddd dd mmmm yyyy")
Nom = Sheets(Nom).Name
If Err Then
Err = 0
Sheets("Modele").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Nom
Sheets(Sheets.Count).[B1] = Nom1
j = 1
For Lig = 4 To 10
Sheets(Sheets.Count).Range("A" & Lig) = tablo1(i, j)
j = j + 1
Next Lig
End If
Next
Sheets("Semaine " & Tablo(Sem, 1) & " - " & Tablo(Sem, 2)).Select 'semaine en cours
End Sub

Cibleo
 

Discussions similaires

Réponses
11
Affichages
238
Réponses
15
Affichages
427

Statistiques des forums

Discussions
311 730
Messages
2 081 978
Membres
101 854
dernier inscrit
micmag26