Microsoft 365 Créer un plusieurs onglet de jours ouvrables d'un modèle selon un mois et une année.

fcu88

XLDnaute Nouveau
Bonjour,

Je cherche à modifier ce fichier excel que j'ai trouvé sur des forums. Il permet de générer autant d'onglet de jours dans le mois saisie.
Ce que je cherche à faire :
- saisir un mois dans l'année
- saisir une année passé ou future
et cela génère un onglet par jour ouvré selon le modèle.

Il me semble que ce genre de question a été abordée dans des discussions mais ma difficulté est de comprendre ces bout de codes et les appliquer à mon fichier.

J'espère avoir été clair.

Merci par avance.
 

Pièces jointes

  • Modele.xlsm
    23.4 KB · Affichages: 13
Solution
Bonjour à tous
Il manque la macro Efface :

VB:
Sub Efface()
Dim Feuille As Worksheet
For Each Feuille In Worksheets
Application.DisplayAlerts = 0
Application.ScreenUpdating = 0
If Feuille.Name <> "Modèle" Then Feuille.Delete
Next Feuille
Application.DisplayAlerts = 1
End Sub
Cordialement

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Une proposition :
VB:
Sub Creation()
Dim NbJ As Long, i As Long, Mois, annee, LaDate
   Efface
   Mois = InputBox("Saisir numéro du mois (1 à 12)")
   annee = InputBox("Saisir une année")
   On Error Resume Next
   LaDate = CDate("1/" & Mois & "/" & annee)
   Err.Clear
   If Not IsDate(LaDate) Then
      MsgBox "Mois et/ou année incorrect => ECHEC"
      Exit Sub
   End If
   NbJ = Day(WorksheetFunction.EoMonth(LaDate, 0))
   Application.ScreenUpdating = 0
   For i = 1 To NbJ
      Sheets("Modèle").Copy After:=Sheets(i)
      ActiveSheet.Name = Format(DateValue(i & "/" & Format(LaDate, "mm/yy")), "dd_mm_yyyy")
      ActiveSheet.Range("A1") = Format(DateValue(i & "/" & Format(LaDate, "mm/yy")), "dddd dd mmmm yyyy")
      ActiveSheet.Shapes("Logo_Code").Delete
   Next i
   Sheets("Modèle").Activate
End Sub
 

Efgé

XLDnaute Barbatruc
Bonjour à tous
Il manque la macro Efface :

VB:
Sub Efface()
Dim Feuille As Worksheet
For Each Feuille In Worksheets
Application.DisplayAlerts = 0
Application.ScreenUpdating = 0
If Feuille.Name <> "Modèle" Then Feuille.Delete
Next Feuille
Application.DisplayAlerts = 1
End Sub
Cordialement
 

Pièces jointes

  • Modele.xlsm
    40.9 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
315 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki