Nombre de jours dans le mois VBA

Bonjour

Je veux créer autant de Feuilles que de jours dans le mois.

Le mois est indiqué en B5 d'une feuille nommée 2 soit '2'!B5

Je crée ces feuilles en copiant cette feuille 2. Pour le moment, je sais créer les feuilles 3 à 31 avec ce Code adapté et bidouillé.

Code

Sub Créer_Mois()
'Code de Jean Rock Gautier
Dim I As Byte
Application.Calculation = xlManual
If Sheets.Count > 4 Then Exit Sub
For I = 3 To 31
  Sheets("2").Copy After:=Sheets(Sheets.Count)
  Sheets(Sheets.Count).Name = Format(I, "0")
Next I
Sheets(1).Select
MsgBox "31 Feuilles ont été créées. Si le mois ne comprends pas 31 jours,supprimez la ou les derniéres feuilles en trop"
End Sub

Comment puis-je adapter ce code en fonction du nombre de jours que contient le mois indiqué en '2'!B5

et ainsi éviter le MsgBox et la suppression manuelle des dernières feuilles en excédent?

Merci aux VBA"istes" qui resoudront mon problème.

Cordialement

Bonjour Amadéus, à tous,

Je suppose qu'en B5, c'est le nombre de jours

j'ai donc ajouté la variable Nb (=B5)

Sub Claude()
Dim I As Byte, Nb As Byte
    Application.Calculation = xlManual
        If Sheets.Count > 4 Then Exit Sub
        Nb = Sheets(2).Range("b5")
            For I = 1 To Nb
              Sheets(2).Copy After:=Sheets(Sheets.Count)
              ActiveSheet.Name = I
            Next I
    Sheets(1).Select
    MsgBox (Nb & " Feuilles ont été créées. Si le mois ne comprends pas 31 jours,supprimez la feuille")
End Sub

Dis-moi si c'est çà que tu souhaitais

Amicalement

Claude.

Bonjour Claude

Merci de me venir en aide

B5 de la Feuille nommée 1 contient la date du premier jour du mois

du style mardi 1 décembre 2009.

Cordialement

3liste.xlsx (12.31 Ko)
4kb.xlsx (9.70 Ko)

re,

Peux-tu me rappeler la formule qui donne le nombre de jours d'un mois donné ?

et comment souhaite-tu le nom des onglets,

1,2,3,4 etc... ou "01 12 09"

çà serait + facile si on avait directement le nombre de jours dans une cellule,

c'est un exercice ?

Amicalement

Claude.

Re,

Afficher le nombre de jours dans un mois , pour une date définie dans la cellule B5 de la Feuille nommée 2

=JOUR(DATE(ANNEE('2'!B5);MOIS('2'!B5)+1;0))

Tout mon code de départ est OK, mais j'ai besoin de créer les feuilles 3 à 30 ou 3 à 31 ou 3 à 28 (passons les bissextiles) selon le nb de jours du mois.

C'est donc sur cette ligne

For I = 3 To 31

que je dois remplacer le 31 par la solution demandée.

(pour un fichier hors Forum, pas un exercice)

J'ai bien trouvé

= Day(DateSerial(Year(LaDate), Month(LaDate) + 1, 1) - 1)

mais, je ne sais pas l'intégrer

Cordialement

re,

tu me dis pas sous quel format nommer les onglets, je reste à 1,2;3;4 etc..

avec la fonction "EOMONTH"

Sub Claude2()
Dim I As Byte, Nb As Long, Nb2 As Long
    Application.Calculation = xlManual
        If Sheets.Count > 4 Then Exit Sub
        Nb = Sheets(2).Range("b5")
        Nb2 = WorksheetFunction.EoMonth(Sheets(2).Range("b5"), 0)
            For I = 1 To (Nb2 - Nb)
              Sheets(2).Copy After:=Sheets(Sheets.Count)
              ActiveSheet.Name = I
            Next I
    Sheets(1).Select
    MsgBox (Nb2 - Nb & " Feuilles ont été créées. Si le mois ne comprends pas 31 jours,supprimez la feuille")
End Sub

Claude

édit: pourquoi tu démarre à 3, c'est voulu ?

re,

il faut ajouter +1 au nombre de jours,

j'ai refait + propre

Sub Claude4()
Dim I As Byte, Nbf As Byte
    Application.Calculation = xlManual
        If Sheets.Count > 4 Then Exit Sub
        Nbf = WorksheetFunction.EoMonth(Sheets(2).Range("b5"), 0) - Sheets(2).Range("b5") + 1
            For I = 1 To Nbf
              Sheets(2).Copy After:=Sheets(Sheets.Count)
              ActiveSheet.Name = I
            Next I
    Sheets(1).Select
    MsgBox (Nbf & " Feuilles ont été créées. Si le mois ne comprends pas 31 jours,supprimez la feuille")
End Sub

édit: tu peux supprimer le MsgBox final

Claude.

Re,

ça coince sur cette ligne

Nbf = WorksheetFunction.EoMonth(Sheets(2).Range("b5"), 0) - Sheets(2).Range("b5")

Cordialement

re,

B5 doit être un format date (numérique)

vérifie en pas à pas (avec F8)

en passant le curseur sur Nbf= , tu dois voir 30 ou 31

çà marche bien chez moi, peut-être la version ?

hors sujet, mais je m'aperçois qu'avec la ligne

Application.Calculation = xlManual

çà reste en manuel pour les autres fichiers, bizarre !

dans le doute, il vaut mieux remettre en auto à la fin

Application.Calculation = xlCalculationAutomatic

Claude

re,

toujours pas. Je t'envoie le fichier allégé

https://www.excel-pratique.com/~files/doc2/Copie_de_Essai_Creation_Onglets.zip

Cordialement

re,

2 trucs qui clochaient

testé chez moi en 2007, c'est ok

https://www.excel-pratique.com/~files/doc2/Creation_Onglets_claude1.zip

si çà coince encore, c'est que non compatible en 2003 ?

Amicalement

Claude.

Bonsoir Amadeus, Claude,

En lisant votre échange, je m'insère dans ce fil avec cette proposition :

Amadeus dans ton premier code, essaie en remplaçant :

For I = 3 To 31

par

For I = 3 To Day(DateSerial(Year(Sheets(2).Range("B5")), Month(Sheets(2).Range("B5")) + 1, 0))

En B5 mets la date sous cette forme --> 1/2/2009 et formate la cellule pour ne voir que le mois.

Amicalement

Bonne soirée à vous deux

Dan

Bonsoir Dan, Claude

Dan, je viens de voir ta réponse, je vais tester et te tiens au courant.

Claude, effectivement, sur XP 2003, cela ne veut pas fonctionner; Je m'en suis tiré (presque) en mettant une cellule contenant le Nb de jours.

Cependant, je n'arrive pas à parfaire la macro pour forcer le recalcul et je dois appuyer sur F9 pour recalculer les dates et la cellule F7 des nouvelles feuilles.

Si vous pouviez m'aider...

https://www.excel-pratique.com/~files/doc2/Claude.zip

Cordialement

Salut le forum

Amadéus une simple formule pour la boucle.

For i = 3 To Day(DateSerial(Year([LaDate]), Month([LaDate]) + 1, 0))

LaDate correspond à ta cellule déjà nommée, en prime tu auras les années bisectilles.

Mytå

Re le forum

Amadéus le code complet de la macro

Sub Créer_Mois()
'Code de Usb512 (Alias Mytå)
Dim I As Byte

If Sheets.Count > 4 Then Exit Sub
    For I = 3 To Day(DateSerial(Year([LaDate]), Month([LaDate]) + 1, 0))
      Sheets("2").Copy After:=Sheets(Sheets.Count)
      Sheets(Sheets.Count).Name = Format(I, "0")
    Next I

Sheets(1).Select

End Sub

Mytå

Bonjour à tous,

désolé Amadéus,

dès le départ, j'ai mal interprété le Sheets(2) et Sheets("2")

heureusement les renforts arrivent, et pas des moindres !

Bonne journée

Claude.

Bonjour à tous

C'est vrai qu'avec une telle équipe, on est sur d'avancer. Merci à tous. Le Code est donc devenu:

Sub Créer_Mois()
'Code de Usb512 (Alias Mytå)
Dim I As Byte
Application.Calculation = xlManual
If Sheets.Count > 4 Then Exit Sub
    For I = 3 To Day(DateSerial(Year([LaDate]), Month([LaDate]) + 1, 0))
      Sheets("2").Copy After:=Sheets(Sheets.Count)
      Sheets(Sheets.Count).Name = Format(I, "0")
    Next I
Application.Calculation = xlCalculationAutomatic
Calculate
MsgBox "Veuillez appuyer sur la touche F9 pour actualiser les Feuilles"
Sheets(1).Select
End Sub

Reste un point à résoudre pour parfaire le tout, celui qui m'éviterait d'avoir à appuyer sur F9 pour actualiser les formules. Quelque chose cloche, car

Application.Calculation = xlCalculationAutomatic
Calculate

Ne réactualise pas mes formules.

Une suggestion?

Sinon, je ferais avec mon F9

Cordialement

5screen-shoot-1.docx (170.54 Ko)
3screen-shoot-2.docx (156.88 Ko)

Re le forum

Amadéus essaye avec

Application.Calculate

Sinon simuler le F9

SendKeys "{F9}"

Mytå

Re le forum

Peut-être en modifiant l'ordre des opérations

' Disable automatic calculation
Application.Calculation = xlCalculationManual
' do regular operation here
' Force a calculation
Application.Calculate
' Then remember to run automatic calculations back on
Application.Calculation = xlCalculationAutomatic

Mytå

Bonjour Mytå

ça marche avec

SendKeys "{F9}"

Merci.

Rechercher des sujets similaires à "nombre jours mois vba"