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

Efgé

XLDnaute Barbatruc

• 12 Décembre 2022

• #2

Bonjour

Pour saluer l'ami @JCGL qui nous manque

Une proposition qui crée les jours ouvrés, donc sans fériés ni dimanche.

Cordialement

 

Pièces jointes

• Modele.xlsm

  164.9 KB · Affichages: 7

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 12 Décembre 2022

• #3

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

 

Vote positif 0 Vote négatif

Efgé

XLDnaute Barbatruc

• 12 Décembre 2022

• #4

RE
Bonjour @mapomme

Bien vu la vérif
Par contre @fcu88 demande les jours ouvrés.
Cordialement

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 12 Décembre 2022

• #5

Efgé à dit:

Par contre @fcu88 demande les jours ouvrés.

Cliquez pour agrandir...

Bonjour @Efgé ,

J'avions point percuté

 

Vote positif 0 Vote négatif

F

fcu88

XLDnaute Nouveau

• 13 Décembre 2022

• #6

Bonjour

@mapomme merci c'est ce que je voulais.
@Efgé si c'est possible ca serait un plus.

Merci à vous deux

 

Vote positif 0 Vote négatif

Efgé

XLDnaute Barbatruc

• 13 Décembre 2022

• #7

Bonjour à tous

fcu88 à dit:

@Efgé si c'est possible ca serait un plus.

Cliquez pour agrandir...

Comprend pas…
Ma proposition le fait, non ?

Cordialement

 

Vote positif 0 Vote négatif

F

fcu88

XLDnaute Nouveau

• 13 Décembre 2022

• #8

Efgé à dit:

Bonjour à tous


Comprend pas…
Ma proposition le fait, non ?

Cordialement

Cliquez pour agrandir...

Je ne sait si je fais les bonnes manip. Sur ton fichier j'ai n'ai laissé que l'onglet modèle et cliquant sur le bouton de la macro cela génère une erreur.

 

Pièces jointes

• Modele (2).xlsm

  24.9 KB · Affichages: 3

Vote positif 0 Vote négatif

Efgé

XLDnaute Barbatruc

• 14 Décembre 2022

• #9

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

Vote positif 0 Vote négatif

Solution

F

fcu88

XLDnaute Nouveau

• 14 Décembre 2022

• #10

Bonjour,

Parfait.
Un grand merci à vous deux @Efgé et @mapomme

 

Vote positif 0 Vote négatif