Fixer date du jour lors de l’exécution d’une macro

[NikoZozo]

Bonsoir,

Voila j’ai crée une macro dans un fichier Excel de contrôle quotidien ci-joint.
Cette macro marche parfaitement, enfin PRESQUE !!!
Celle-ci me duplique bien ma dernière feuille avec le jour dans l’onglet, placement en dernière position, effacement de certains champs + la date complète dans une cellule et tout et tout …

Mais mon soucie est que pour l’insertion de la date du jour complète avec ma macro dans la cellule B3. Celle-ci fait appelle à cette fonction =AUJOURDHUI() ce qui est très bien pour la création de la feuille du jour, mais pas pour les autres feuilles précédentes de mon classeur, car celles-ci se mettent automatiquement à jour en récupérant cette date « du jour ». Alors qu’il faudrait que celles-ci restent figés à la date d’exécution de la macro et non quelle reprenne par la suite la date du jour.

Merci d’avance pour votre aide, si quelqu’un pouvait modifier ma macro pour pallier ce problème, je serais comblé !!!

Merci d’avance et merci également aux personnes ayant créé ce forum, pour tous les astuces et code que l’on peut y trouver.

Voici le code de ma macro « AjoutFeuille » :

Sub AjoutFeuille()
'
' AjoutFeuille Macro
' Macro enregistrée
'

'
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
ActiveWindow.SmallScroll ToRight:=1
Range('C7:F39').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-18
ActiveWindow.SmallScroll ToRight:=-1
Range('A1').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=33
Range('C44:F52').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=18
Range('C57:F71').Select
ActiveWindow.SmallScroll ToRight:=2
Selection.ClearContents
ActiveWindow.SmallScroll ToRight:=-2
ActiveWindow.SmallScroll Down:=18
Range('C76:F78').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=9
Range('C83:F85').Select
Selection.ClearContents
Range('C88:F89').Select
Selection.ClearContents
Range('C92:F92').Select
Selection.ClearContents
Range('C93:F93').Select
Selection.ClearContents
Range('C95:F95').Select
Selection.ClearContents
Range('C96:F96').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=12
Range('C98:F100').Select
Selection.ClearContents
Range('C103:F105').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=6
Range('C108:F110').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=9
Range('C113:F115').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=9
Range('C120:F120').Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=9
ActiveWindow.SmallScroll Down:=-132
Range('B3').Select
Selection.ClearContents
Range('B3').Select
ActiveCell.FormulaR1C1 = '=TODAY()'
Range('B3').Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = True
With Selection.Font
.Name = 'Arial'
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
With Selection.Font
.Name = 'Arial'
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
Selection.NumberFormat = 'dddd-d-mmm-yyyy'
Range('B3').Select
ActiveCell.FormulaR1C1 = '=TODAY()'
Range('B4').Select
ActiveWindow.SmallScroll Down:=-3
ActiveSheet.Name = Day(Date)
End Sub
[file name=controledumois.zip size=14990]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/controledumois.zip[/file]

Message édité par: Pascal76, à: 29/03/2006 07:53

 

[Staple1600]

Re:Fixer date du jour lors de l’exécution d’une ma

Bonsoir

Remplace
ActiveCell.FormulaR1C1 = '=TODAY()'
par
ActiveCell.Value = Date

 

[Climaudo]

Re:Fixer date du jour lors de l’exécution d’une ma

Bonsoir NikoZozo,

Tu peux remplacer ton ActiveCell.FormulaR1C1='=Today()' par ActiveCell.FormulaR1C1 = Date

Bonne soirée

edition : oups, pas rafraichi, bonjour Staple

Message édité par: climaudo, à: 28/03/2006 22:59

 

[Staple1600]

Re:Fixer date du jour lors de l’exécution d’une ma

Re

A tester
(j'ai fait un peu le ménage)
Sub AjoutFeuille()

Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)

Range('C7:F39').ClearContents
Range('A1').ClearContents
Range('C44:F52').ClearContents
Range('C57:F71').ClearContents
Range('C76:F78').ClearContents
Range('C83:F85').ClearContents
Range('C88:F89').ClearContents
Range('C92:F92').ClearContents
Range('C93:F93').ClearContents
Range('C95:F95').ClearContents
Range('C96:F96').ClearContents
Range('C98:F100').ClearContents
Range('C103:F105').ClearContents
Range('C108:F110').ClearContents
Range('C113:F115').ClearContents
Range('C120:F120').ClearContents
Range('B3').Value = Date
Range('B3').Select
With Selection.Font
.Name = 'Arial'
.Size = 14
.ColorIndex = 3
End With
Selection.NumberFormat = 'dddd-d-mmm-yyyy'
Range('B3').Select
ActiveCell.Value = Date
Range('B4').Select
ActiveWindow.SmallScroll Down:=-3
ActiveSheet.Name = Day(Date)
End Sub

 

[NikoZozo]

Re:Fixer date du jour lors de l’exécution d’une ma

Ok, merci beaucoup à tous les deux pour vos réponses ultra rapides !!!

Je viens de faire la modifs

 

[Staple1600]

Re:Fixer date du jour lors de l’exécution d’une ma

Re
Un dernier petit ménage
Sub AjoutFeuilleII()
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
Range('C7:F39').ClearContents
Range('A1').ClearContents
Range('C44:F52').ClearContents
Range('C57:F71').ClearContents
Range('C76:F78').ClearContents
Range('C83:F85').ClearContents
Range('C88:F89').ClearContents
Range('C92:F92').ClearContents
Range('C93:F93').ClearContents
Range('C95:F95').ClearContents
Range('C96:F96').ClearContents
Range('C98:F100').ClearContents
Range('C103:F105').ClearContents
Range('C108:F110').ClearContents
Range('C113:F115').ClearContents
Range('C120:F120').ClearContents
Range('B3').Value = Date
Range('B3').Select
With Selection
.Font.Name = 'Arial'
.Font.Size = 14
.Font.ColorIndex = 3
.NumberFormat = 'dddd-d-mmm-yyyy'
End With
ActiveSheet.Name = Day(Date)
End Sub

 

[Staple1600]

Re:Fixer date du jour lors de l’exécution d’une ma

Donc
le code modifié fonctionne correctement chez toi,?

 

[NikoZozo]

Re:Fixer date du jour lors de l’exécution d’une ma

Merci Staple1600 pour cette superbe optimisation. Je n’en reviens pas de voir à quel degré mon script peut être simplifié. :woohoo: :lol:

 

[Staple1600]

Re:Fixer date du jour lors de l’exécution d’une ma

Content que cela te satisfasse

Mais ca doit encore pouvoir etre modifié

Je laisse ce soin aux autres forumeurs

Bonne nuit à tous

 

[myDearFriend!]

Re:Fixer date du jour lors de l’exécution d’une ma

Bonsoir NikoZozo, Staple1600, Climaudo,

Une proposition de plus...

Sub AjoutFeuille()
      Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
      Range('A1,C7:F39,C44:F52,C57:F71,C76:F78,C83:F85,C88:F89,C92:F92,' _
            & 'C95:F95,C98:F100,C103:F105,C108:F110,C113:F115,C120:F120').ClearContents
      Range('B3').Value = Date
      ActiveSheet.Name = Day(Date)
End Sub

Comme tu recopies à chaque fois la feuille, j'en ai déduit que le reformatage de la cellule B3 (police, format de nombre...) devenait inutile.

Par ailleurs, comme notre ami Staple1600 commençait à le faire, les 'Select' de cellules et plages sont inutiles et même déconseillés avec VBA, que ce soit pour modifier le contenu des objets Range ou même pour modifier leur format.

Dans ton code, je pense qu'il conviendra également de prévoir la gestion de l'erreur générée si l'utilisateur clique 2 fois le même jour sur le bouton 'Ajout Feuille du jour'. Si la feuille 'Day(Date)' existe déjà...

Cordialement,

Message édité par: myDearFriend!, à: 28/03/2006 23:25

 

[NikoZozo]

Re:Fixer date du jour lors de l’exécution d’une ma

Merci à tous et merci à toi myDearFriend!


Ca c'est de l'optimisation diabolique :woohoo: qui marche nickel chrome !!! thanks aussi pour les explications sur selects en VBA

myDearFriend! quand tu parle de prévoir la gestion de l'erreur générée si l'utilisateur clique 2 fois le même jour sur le bouton \\'Ajout Feuille du jour\\'

Premièrement je trouve que cela est une très très bonne idée
Mais deuxièmement comment faire cela ? quelles sont les différentes possibilitées ? et surtout comment le verais tu de ton côté myDearFriend! (car tu me semble pleins de bonnes idée à une heure si tardive )?
Serait t'il possible d'afficher un message dans une boite de dialogue indiquant que celle-ci a déjà été lancé et empechant par consequent, la creation d'une nouvelle feuille ?
(Quoi qu'il pourrait etre sympa de pouvoir demander la creation d'une autre feuille pour un evenement spécial par exemple le week-end, mais il faudrait alors que la macro affiche une boite de dialogue dans laquel on puisse rentrer manuelement le jour de la feuille à ajouter)==> la je pense que deja ca doit se compliquer serieusement

Merci encore à tous et bonne nuit

 

[myDearFriend!]

Re:Fixer date du jour lors de l’exécution d’une ma

Re NikoZozo,

Pour répondre à ta question :

Sub AjoutFeuille()
Dim F As Worksheet
Dim Nom As String
      Nom = CStr(Day(Date))
      On Error Resume Next
      Set F = Sheets(Nom)
      On Error GoTo 0
      If Not F Is Nothing Then
            MsgBox 'La feuille du jour existe déjà !'
            Exit Sub
      End If
      Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
      Range('A1,C7:F39,C44:F52,C57:F71,C76:F78,C83:F85,C88:F89,C92:F92,' _
              & 'C95:F95,C98:F100,C103:F105,C108:F110,C113:F115,C120:F120').ClearContents
      Range('B3').Value = Date
      ActiveSheet.Name = Nom
End Sub

Concernant ta deuxième suggestion :

Sub AjoutFeuille()
Dim F As Worksheet
Dim R As Variant
Dim Nom As String
      Nom = CStr(Day(Date))
      On Error Resume Next
      Set F = Sheets(Nom)
      On Error GoTo 0
      If Not F Is Nothing Then
            R = InputBox(Prompt:='La feuille du jour existe déjà !' & vbLf _
                  & 'Si vous souhaitez continuer, donnez un autre nom et validez par OK.', _
                  Title:='Erreur...', Default:=Nom)
            If R = False Or R = Nom Then Exit Sub
            Nom = R
      End If
      Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
      Range('A1,C7:F39,C44:F52,C57:F71,C76:F78,C83:F85,C88:F89,C92:F92,' _
              & 'C95:F95,C98:F100,C103:F105,C108:F110,C113:F115,C120:F120').ClearContents
      Range('B3').Value = Date
      ActiveSheet.Name = Nom
End Sub

Cordialement,

 

[_Thierry]

Re:Fixer date du jour lors de l’exécution d’une ma

Bonjour à tous

Une version un peu plus 'bétonnée' niveau gestion d'erreur que celle de mon copain Didier, certe plus longue, d'autant plus qu'écrite avec une seule main, mais justement c'est bien dans l'intention de ne pas perdre... la main !! arf facile celle-là lol

Option Explicit

Const Plage As String = 'A1,C7:F39,C44:F52,C57:F71,C76:F78,C83:F85,C88:F89,C92:F92,' & _
                        'C95:F95,C98:F100,C103:F105,C108:F110,C113:F115,C120:F120'

Dim WSnameInput As String

Sub TheRunner()
Dim Nom As String
   
    Nom = CStr(Day(Date))
     
    If TheWsheetChecker(Nom) Then
         
      Select Case TheMessenger(Nom)
            Case '': Exit Sub
            Case Else
            Do While TheWsheetChecker(CStr(WSnameInput))
                  TheMessenger (WSnameInput)
            Loop
            If TheMessenger(Nom) = '' Then Exit Sub
            TheSheetBuilder
            End Select
   
    Else
    TheSheetBuilder
    End If
 

End Sub
 
Function TheWsheetChecker(WSName As String) As Boolean
Dim WS As Worksheet
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = WSName Then TheWsheetChecker = True
    Next
WSnameInput = WSName
End Function
 
Function TheMessenger(WSName As String) As String

TheMessenger = InputBox(Prompt:='La feuille' & WSName & ' existe déjà !' & vbLf _
                                & 'Si vous souhaitez continuer, donnez un autre nom et validez par OK.', _
                                  Title:='Erreur...', Default:=WSName)
WSnameInput = TheMessenger
End Function

 
 
Sub TheSheetBuilder()
Dim WSNew As Worksheet
   
    With ThisWorkbook
      .Sheets(.Sheets.Count).Copy After:=.Sheets(.Sheets.Count)
      Set WSNew = .Sheets(.Sheets.Count)
    End With
    With WSNew
      .Range(Plage).ClearContents
      .Range('B3').Value = Date
      .Name = WSnameInput
    End With

End Sub

Bonne journée et appétit
[ol]@+Thierry[/ol]

Message édité par: _Thierry, à: 29/03/2006 11:24

 

[NikoZozo]

Re:Fixer date du jour lors de l’exécution d’une ma

Un grand merci à tous les gars,
c'est super ! :woohoo: mon classeur Excel est magique grace à vous :woohoo: :lol: