Recuperer le nom de la derniere feuille [ RESOLU ]

[popcorn]

Bonjour,


J'ai un classeur Excel qui contient une feuille par jour (planning de livraison). Pour éviter de faire des copier/coller manuellement, j’essaie de faire une macro.

En écumant les forums, j'ai récupérer des bouts de code et j'arrive tant bien que mal à créer une copie de ma feuille sur une année complète sans les week end en les renommant avec une date.

Je me rend bien compte que ce n'est pas très pratique à ce jour, mon fichier sera bon qu'a partir du 1 janvier car je pourrai repartir sur un classeur totalement vierge.

J'ai aussi à l'esprit que plus de 250 feuilles sur un classeur cela ne doit pas être bien terrible, bien que celle ci ne soit pas chargées de formule, c'est essentiellement de la saisie.

J'aurais souhaité récupérer la date du dernier onglet du classeur en variable comme point départ, par exemple si la dernière feuille se nomme 3105 , il faudrait que la copie suivante soit 0106 et ainsi de suite.

Voila le bout de code que j'utilise :

Sub test()
Dim x, i
'Le nom des feuilles seront incrementé apres le 1 janvier
'x = DateSerial(Year(Date), 1, 1)
'les noms des feuilles seront incrementées apres la date du jour actuel
x = Now()
For i = 1 To 5  '365
Select Case Weekday(CDate(x + i), vbMonday)
Case 1 To 5
      With ActiveWorkbook.ActiveSheet
        .Copy After:=Worksheets(Worksheets.Count)
      End With
    ActiveSheet.Name = Format(CDate(x + i), "ddmm")
    End Select
    Next i
End Sub

J'espere avoir été clair, mais il est possible que je fasse mauvaise route.

Bien à vous
Merci

 

[sousou]

Bonsoir
Regarde ce code qui calcul le nom de la feuille suivante
With ThisWorkbook
jour = Right(.Sheets(.Sheets.Count).Name, 2)
mois = Left(.Sheets(.Sheets.Count).Name, 2)
nfeuille = CDate(jour & "/" & mois & "/" & Year(Date)) + 1
nomfeuille = Format(Day(nfeuille), "00") & Format(Month(nfeuille), "00")
End With

 

[popcorn]

Bonjour,

Merci, je vais regarder de prés mais je suis loin d’être expert en vba.

Je reviens ici poster ce que je peux.

Merci

 

[sousou]

bonjour
Voci ton code modifié, d'autant plus que j'avais une erreur( j'avais inversé le mois et le jour)

Sub test()
Dim x, i
'Le nom des feuilles seront incrementŽ apres le 1 janvier
'x = DateSerial(Year(Date), 1, 1)
'les noms des feuilles seront incrementŽes apres la date du jour actuel
x = Now()
For i = 1 To 5 '365
Select Case Weekday(CDate(x + i), vbMonday)
Case 1 To 5
'calcul du nom de la feuille à créer
With ThisWorkbook
jour = Left(.Sheets(.Sheets.Count).Name, 2)
mois = Right(.Sheets(.Sheets.Count).Name, 2)
nfeuille = CDate(jour & "/" & mois & "/" & Year(Date)) + 1
nomfeuille = Format(Day(nfeuille), "00") & Format(Month(nfeuille), "00")
End With
'__________________________________


With ActiveWorkbook.ActiveSheet
.Copy After:=Worksheets(Worksheets.Count)
End With
ActiveSheet.Name = nomfeuille
' ActiveSheet.Name = Format(CDate(x + i), "ddmm")
End Select
Next i
End Sub

 

[Dranreb]

Bonjour.
Je dirais plutôt comme ça :

Sub test2()
Dim F As Worksheet, NF As String, D As Date
Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
NF = F.Name
D = DateSerial(Year(Date), Right$(NF, 2), Left$(NF, 2))
Do: D = D + 1: Loop Until Weekday(D, vbMonday) <= 5
F.Copy After:=F
Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
F.Name = Format(D, "ddmm")
End Sub

Mais je trouve qu'il serait plus prudent, pour éviter un incident en début ou fin d'année, de s'appuyer sur une date mise en cellule I5 de la feuille, avec format JJMM pour que ça affiche pareil.

La procédure deviendrait alors :

Sub test3()
Dim F As Worksheet, NF As String, D As Date
Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
D = F.[I5].Value
Do: D = D + 1: Loop Until Weekday(D, vbMonday) <= 5
F.Copy After:=F
Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
F.[I5].Value = D
F.Name = Format(D, "ddmm")
End Sub

 

[sousou]

D'accord sur ta remarque

 

[popcorn]

Merci, c'est top.

Du coup j'avais un peu bossé aussi, j'avais détourné le truc en rajoutant une inputbox pour saisir la date de la dernière feuille.

Au moins, j'ai apprit quelques trucs. Je met le code si ça intéresse du monde qui passe, bon par contre, il est pas nettoyé car j’essaie d'autres choses.

Remarque : Ma fonction pour faire sauter les week end ne peut pas fonctionner de cette façon car cela fonctionne sur un décompte de 5 jours à partir du lundi hors de cette manière le programme ne sait pas quel jour on est, il va sauté 2 feuilles toutes les 5 feuilles.

J'ouvrirais un autre sujet pour pas s'egarer de celui ci qui est RESOLU : Merci encore sousou!
Quand je vois le code maintenant, je me dis.. hé, merde.

Donc ci dessous le code avec une inputbox pour saisir la date :

Sub test()
'Dim x
Dim y As String
Dim a As Date
'Dim j As Integer
Dim i As Integer
'Dim b As Integer

    'Inputbox pour determiner la reference pour copié les nouveaux onglets
    y = InputBox("Quelle est la date de la dernière feuille?", "Important", "00/00/0000")
   
    Do
  ' Vérifier que la saisie est bien transformable en date
    If IsDate(y) Then
    ' Si la saisie est bien une date...
    a = CDate(y)

  Exit Do
  Else
    ' Si la saisie est incorrecte...
    MsgBox "Vous n'avez pas tapé la date au bon format !", vbExclamation
     y = InputBox("Quelle est la date de la dernière feuille?", "Important", "00/00/0000")
     End If
  Loop
   
     'Inputbox pour choisir le nombre de jour à ajouter
     'j = InputBox("Combien de jours à ajouter?")
    
        'Do
  ' Vérifier que la saisie est bien transformable en nombre
    'If Not IsNumeric(j) Then
    ' Si la saisie est bien une date...
    'b = IsNumeric(j)
   

' Exit Do
  'Else
    ' Si la saisie est incorrecte...
    'MsgBox "Vous n'avez pas tapé un chiffre au bon format !", vbExclamation
     'y = InputBox("Combien de jours à ajouter?")
     'End If
  'Loop
    'Le nom des feuilles seront incrementé apres le 1 janvier
     'x = DateSerial(Year(Date), 1, 1)
    'les noms des feuilles seront incrementées apres la date du jour actuel
     'x = Now()
    'fixera le nombre de feuille copiéé via l'inputbox
    'For i = 1 To j
    'fixera le nombre de feuille copiéé en dur, ici 10 pour le test
    For i = 1 To 10  '365
    'ligne suivante à decommenter si inputbox est activé
    'If j = 0 Then Exit Sub

'Permet de prendre en compte seulement les jours ouvrés à partir du lundi
'Select Case Weekday(CDate(a + i), vbMonday)
'Case 1 To 5
      With ActiveWorkbook.ActiveSheet
        .Copy After:=Worksheets(Worksheets.Count)
      End With
     
      'Renome la feuille avec son format de date
    ActiveSheet.Name = Format(CDate(a + i), "ddmm")

    'End Select
    Next i
End Sub

 

[popcorn]

Je viens juste de voir ton message Dranreb, Merci.

Ah oui, en effet, j'ai pas pensé en début et fin d'année.

Je m'y colle cet après midi.

Merci

 

[Dranreb]

S'il faut toujours ajouter 10 feuilles d'un coup, sans samedi dimanche et en retenant le principe de la date en I5, ça peut s'écrire comme ça :

Sub test4()
Dim F As Worksheet, NF As String, D As Date, NbF As Long
Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
D = F.[I5].Value
For NbF = 1 To 10
   Do: D = D + 1: Loop Until Weekday(D, vbMonday) <= 5
   F.Copy After:=F
   Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
   F.[I5].Value = D
   F.Name = Format(D, "ddmm")
   Next NbF
End Sub

 

[popcorn]

Bonjour,

Tu m'as donné une idée. Je pensais faire une input box pour choisir le nombre de copie.
Du coup, je regarde comment repeter une macro x fois en fonction du nombre saisi dans l' inputbox.

Cela laissera la possibilité de creer une copie avec un raccourci avec ta macro ou en plusieurs via l'inputbox.

J'essaye ça mais en vain :

Sub repetermacro()
Dim a As integer
Dim b As String

a = InputBox("Combien de fois voulez-vous exécuter la macro test3?", "Nombre d'exécution") 'demande nombre d'exécution

Do While IsNumeric(a)  'vérifie si c'est numérique
If Not IsNumeric(a) Then
b = MsgBox("Vous n'avez pas saisi un chiffre! Voulez-vous continuer?", vbYesNo, "Erreur dans la saisie") ' demande à l'utilisateur s'il a tapé autre chose qu'un chiffre s'il veut continuer
If b = 7 Then
Exit Sub 'si non, fin de la macro
Else
a = InputBox("Combien de fois voulez-vous exécuter la macro test3?", "Nombre d'exécution")
End If
End If
Loop

For b = 1 To a 'boucle qui tournera en fonction de la saisie
Call test3 'appel de la macro
Next b

End Sub

En tout cas merci, c'est deja top.

 

[Dranreb]

Sub Test5()
Dim F As Worksheet, NF As String, D As Date, NbF As Long
Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
D = F.[I5].Value
On Error Resume Next
NbF = InputBox("Nombre de feuilles à créér :", "Test5", 10)
On Error GoTo 0
Do While NbF > 0: NbF = NbF - 1
   Do: D = D + 1: Loop Until Weekday(D, vbMonday) <= 5
   F.Copy After:=F
   Set F = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
   F.[I5].Value = D
   F.Name = Format(D, "ddmm")
   Loop
End Sub

 

[popcorn]

Mais non, c'est parfait!!

Je passe plus de une demi journée pour trouver ça!!

Pour pousser le truc, j'ai une liste avec toutes les dates de l'année en cours au format des libellés des feuilles, et une colonne correspondante qui me renvoi VRAI ou FAUX si c'est un jour ouvré ou un week end et jour ferié.

Est ce que ce serait possible de récupérer ces informations et aller supprimer les feuilles qui correspondent à des jours fériés?

C'est pas vraiment important car on doit être à 11 jours férié par an, je peux très bien les supprimé manuellement.

Pareil, je pose le code si ça interresse du monde :

Jour ouvré :

 'Cette fonction renvoie Vrai si la date transmise est un jour férié
' fixe ou mobile
' les lundis de paques ne sont pas calculés mais trouvés sur le site
' de l'Institut de Mécanique Céleste et de Calcul des Ephémérides (IMCCE)
' par exemple

Private Function Ferie(UneDate As Long, Optional DimanchesOuiNon As Boolean) As Boolean
' Par défaut la fonction ne considère pas que les Dimanche de Pâques
' et de Pentecôte sont fériés
' il suffit de renseigner l'argument DimanchesOuiNon à True à l'appel de la fonction
' pour les considérer comme fériés
If IsSamediDimange(UneDate) Then
    Ferie = True
    Exit Function
End If
If IsNull(DimanchesOuiNon) Then DimanchesOuiNon = True

Dim JFF ' table des fériés fixes (jours)
Dim MFF ' table des fériés fixes (mois)
JFF = Array(1, 1, 8, 14, 15, 1, 11, 25)
MFF = Array(1, 5, 5, 7, 8, 11, 11, 12)
Dim J As Long
Ferie = False
' Recherche dans la table des jours fériés fixes
For J = 0 To 7
If Day(UneDate) = JFF(J) And Month(UneDate) = MFF(J) Then
Ferie = True
Exit Function
End If
Next J
Dim FM ' contient les dates des lundis de Paques
'FM = Array(38824, 39181, 39531, 39916, 40273, 40658, 41008, _
'41365, 41750, 42100, 42457, 42842, _
'43192, 43577, 43934, 44291, 44675, _
'45026, 45383, 45768, 46118, 46475, _
'46860, 47210, 47595)

FM = Paque(Year(UneDate))
' Recherche si la date est un lundi de paques
' ou jeudi de l'ascension
' ou lundi de pentecôte
'For J = 0 To 24 ' à changer si vous allez au delà de 2030
If (UneDate = FM) Or (UneDate = FM + 39) Or (UneDate = FM + 50) Then
Ferie = True
Exit Function
End If
' si DimanchesOuiNon est vrai
' on teste les dimanches de Pâques et Pentecote


If DimanchesOuiNon Then
If (UneDate = FM - 1) Or (UneDate = FM + 48) Then
Ferie = True
Exit Function
End If
End If
'Next J
End Function
Private Function IsSamediDimange(J) As Boolean
If Weekday(J) = 1 Then IsSamediDimange = True
If Weekday(J) = 7 Then IsSamediDimange = True
End Function

Private Function Paque(Annee As Integer) As Date
Dim A, B, C, d, E, F, G, H, I, J, K, l, M, N, O
C = Annee - 1900
d = C Mod 19
E = (d * 7) + 1
F = Int(E / 19)
G = 11 * d - F + 4
H = G Mod 29
I = Int(C / 4)
J = C - H + I + 31
l = J Mod 7
K = J Mod 7
l = 25 - H - K
M = CDate("31/03/" & Annee)
Paque = M + l
End Function

Juste pour apprendre un peu plus..

Merci et longue vie au forum.

 

[Dranreb]

Vous devriez pouvoir ajouter derrière Loop Until Weekday(D, vbMonday) <= 5 And Not Ferie(D, False)
Ou le remplacer tout simplement par Loop Until Not Ferie(D, True)

 

[popcorn]

Je comprend pas comment peut se faire le lien entre la variable D et la fonction Ferie. Car cette variable devrait etre comparer avec la liste des variable générer par la fonction Ferie.

Je m'explique surement pas très bien, c'est loin d’être clair pour moi. Je continue de regarder.

Cordialement

 

[Dranreb]

Votre fonction Ferie ne génère rien du tout de non local.
Les liens se font comme toujours via les paramètres qui lui sont spécifiés et la valeur qu'elle retourne.

À propos de paramètres, il vaudrait mieux les spécifier comme ça :

Private Function Ferie(ByVal UneDate As Date, Optional ByVal DimanchesOuiNon As Boolean) As Boolean