problème message box

alexbud

XLDnaute Nouveau
Bonjours a tous. J'ai créé une macro pour archiver des lignes qui s'incrément en ligne 54 , mais je n'arrive pas a faire une condition pour interdir un nouvel archivage avec un msg box "vous avez déjà archivé aujourd'hui", si la date est celle d'aujourd'hui.
Merci pour votre aide
 

Pièces jointes

  • GNV.xlsm
    55.6 KB · Affichages: 7

alexbud

XLDnaute Nouveau
Merci Dudu2. mais je ne comprend pas comment utiliser ton code. J'ai soit le message même si la date n'est pas celle d'aujourd'hui, soit le message avec la date d'aujourd'hui, mais la ligne s'incrément quand même.
voici mon code
Sub archive()

DateAuj = Sheets("PROGRESS REPORT DASHBOARD").Range("C54").Value

Rows("54:54").Select

Selection.Insert Shift:=x1Down, CopyOrigin:=x1FormatFromAbove

Sheets("PROGRESS REPORT DASHBOARD").Range("C54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("I2").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("D54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G12").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("E54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G24").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("F54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G32").Value

Sheets("PROGRESS REPORT DASHBOARD").Range("G54").Value = Sheets("PROGRESS REPORT DASHBOARD").Range("G47").Value

End Sub
 

Dudu2

XLDnaute Barbatruc
VB:
Option Explicit

Sub Archive()
    With Sheets("PROGRESS REPORT DASHBOARD")
        If .Range("C54") = Date Then
            MsgBox "Vous avez déjà archivé aujourd'hui !"
            Exit Sub
        End If
  
        .Rows(54).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("C54").Value = Date
        .Range("D54").Value = .Range("G12").Value
        .Range("E54").Value = .Range("G24").Value
        .Range("F54").Value = .Range("G32").Value
        .Range("G54").Value = .Range("G47").Value
    End With
End Sub

Le AUJOUDHUI() en I2 ne sert à rien, tu peux le supprimer.
 

Dudu2

XLDnaute Barbatruc
A ta place je ferais plutôt ça...
D'une part ne pas interdire l'archivage multiple sur la date du jour au cas où il y aurait une correction.
D'autre part informer de l'action du bouton quand elle est terminée.
Code:
Option Explicit

Sub Archive()
    With Sheets("PROGRESS REPORT DASHBOARD")
        'Si la date en C54 n'est pas la date du jour, on insert une ligne
        If .Range("C54") <> Date Then
            .Rows(54).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    
        'Recopie des valeurs
        .Range("C54").Value = Date
        .Range("D54").Value = .Range("G12").Value
        .Range("E54").Value = .Range("G24").Value
        .Range("F54").Value = .Range("G32").Value
        .Range("G54").Value = .Range("G47").Value
    End With
    
    MsgBox "Archivage terminée !"
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 125
Membres
112 666
dernier inscrit
Coco0505