Incrémentation journalière auto

Version imprimable

31/01/2014, 21h58
mimicraquelin

Incrémentation journalière auto

Bonsoir,
Je souhaite réaliser une macro, me permettant d'écrire à partir de l'information en A1 (le nom du mois) ,dans la colonne A la date journalière et dans la colonne B comme ci- dessous:
Février
1/02/14 M
M
S
S
N
N
2/02/14 M
et ainsi de suite jusqu'au dernier jour du mois.
je devrai pouvoir utiliser cette macro pour tous les mois de l'année, dans une même feuille XL, un mois par onglet.
J'ai déjà essayé, mais je n'arrive pas à faire le lien entre le mois et le nombre de ligne nécessaire pour un mois.
Merci beaucoup de votre aide
Cordialement
mimicraquelin

Bonjour,

Essaie cette macro. L'orthographe des mois doit être exactement le même que ceux de la macro (majuscules et accents compris); sinon, modifie la macro.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Recopie()
    Dim An As Integer, Mois As Variant, Dat As Date, M As Byte, Jour As Byte, Ligne As Integer
    Mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", _
        "Août", "Septembre", "Octobre", "Novembre", "Décembre")
    An = 2014
    M = Application.Match([A1], Mois, 0)
    Dat = DateSerial(An, M, 1)
    Do While Month(Dat) = M
        Ligne = Ligne + 1
        Cells(Ligne, 2) = [A1]
        Ligne = Ligne + 1
        Cells(Ligne, 2) = Format(Dat, "d/mm/yy") & " M"
        Ligne = Ligne + 1
        Cells(Ligne, 2) = "M"
        Ligne = Ligne + 1
        Cells(Ligne, 2).Resize(2) = "S"
        Ligne = Ligne + 2
        Cells(Ligne, 2).Resize(2) = "N"
        Ligne = Ligne + 1
        Dat = Dat + 1
    Loop
End Sub

Bonjour,

Citation:

J'ai déjà essayé, mais je n'arrive pas à faire le lien entre le mois et le nombre de ligne nécessaire pour un mois.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub Test() Dim Annee As Integer Dim NumMois As Integer Annee = 2013 'pour savoir si bissextile NumMois = 2 'ici février MsgBox Choose(NumMois, 31, IIf((Annee Mod 4 = 0 Or Annee Mod 4 = 0 And Annee Mod 100 <> 0) = False, 28, 29), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) End Sub
il suffit de multiplier par le nombre de lignes que tu souhaite avoir entre chaque jour.

Hervé.

01/02/2014, 17h08
Daniel.C
Une autre façon de faire pour trouver le nombre de jours d'un mois :
Code:

1 2 Mois = 2 MsgBox Day(DateSerial(2014, Mois + 1, 0))
01/02/2014, 20h28
mimicraquelin

1 pièce(s) jointe(s)

incrémentation auto journalière

Merci Daniel.C et These, de vous être penché sur mon cas, et pour vos réponses.
Le message envoyé hier ne reflète pas exactement ce que souhaite, Je l'ai bien taper, mais la mise en forme auto , pour l'envoie me la modifié; je vous envoie donc une photo. j'ai essayé la macro Daniel.C; elle est parfaite par rapport au libellé d'hier; mais si vous pouviez la modifier pour que j'ai exactement ce qu'il y a sur la pièce jointe , pour chaque mois. Désolé pour ce contre temps.

Merci d'avance
Cordialement
mimicraquelin

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Recopie()
    Dim An As Integer, Mois As Variant, Dat As Date, M As Byte, Jour As Byte, Ligne As Integer
    Mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", _
        "Août", "Septembre", "Octobre", "Novembre", "Décembre")
    An = 2014
    Ligne = 1
    M = Application.Match([A1], Mois, 0)
    Dat = DateSerial(An, M, 1)
    Do While Month(Dat) = M
        Ligne = Ligne + 1
        Cells(Ligne, 1) = Dat
        Cells(Ligne, 1).NumberFormat = "d/mm/yy"
        Cells(Ligne, 2) = "M"
        Ligne = Ligne + 1
        Cells(Ligne, 2) = "M"
        Ligne = Ligne + 1
        Cells(Ligne, 2).Resize(2) = "S"
        Ligne = Ligne + 2
        Cells(Ligne, 2).Resize(2) = "N"
        Ligne = Ligne + 1
        Dat = Dat + 1
    Loop
End Sub

02/02/2014, 18h47
mimicraquelin

incrémentation journalière

Merci Daniel.C, cela correspond exactement et résout mon problème.
Encore merci
Cordialement
Mimicraquelin