Condition d'une cellule dans une boucle d'instruction

Bonjour le Forum,

Novice en VBA, j'ai besoin de vos connaissances.

J'ai un tableau où je souhaite vérifier que la date entrée dans la colonne "tif archivage" soit identique à celle de la date de modification du fichier.

La macro doit vérifier sur chaque ligne du tableau et :

Si toutes les dates sont identiques : message box "Dates : OK" et le texte de chaque ligne passe de couleur verte.

Si une des dates n'est pas identique : message box "Dates : NOK " et le texte des lignes concernées passe de couleur rouge.

Mon problème est double

• 1 : je n'arrive pas à aller chercher la date de la colonne "tif archivage" pour lancer la vérification.
• 2 : Comment afficher une message box finale verifiant que toutes les dates sont ok ou pas

ci-joint mon excel avec sa macro.

Aussi, ce tableau est copié sur plusieurs onglets et aura donc un nom différent suivant l'onglet.

Merci de votre aide

Bonjour,

A tester :

Sub TestDate()

    Dim Plage As Range
    Dim Cel As Range
    Dim Fichier As String
    Dim LaDate As Date
    Dim Nb As Long

    Fichier = "C:\Users\Public\Documents\" & Cel.Value & ".tif"
    If Dir(Fichier) = "" Then Exit Sub 'vérifie que le fichier existe bien à l'endroit indiqué

    With ActiveSheet: Set Plage = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In Plage

        LaDate = DateValue(FileDateTime(Fichier))

        If Cel.Offset(, 6).Value = LaDate Then Nb = Nb + 1

    Next Cel

    If Nb = Plage.Count Then

        With Plage.Font
           .ThemeColor = xlThemeColorAccent6
           .TintAndShade = -0.249977111117893
        End With

    Else

        With Plage.Font
            .Color = -16776961
            .TintAndShade = 0
        End With

    End If

End Sub

Merci Theze,

J'ai testé mais la macro stop à la 1ère variable "fichier" où j'ai indiqué une autre adresse "G:\Archivage\Petro Assem\" à la place de "C:\Users\Public\Documents\"

Les fichiers se trouvent sur un serveur, c'est peut être ce qui pose problème?

Une adresse de serveur et une adresse locale ne sont pas construite de la même façon !

adresse de serveur :

\\nomduserveur\Dossier1\Dossier2\...\nomdufichier.tif

adresse en local :

C:\Dossier1\Dossier2\...\nomdufichier.tif

Ok merci,

la ligne ne fonctionne pas non plus avec l'adresse serveur.

Aussi, a quel moment la macro appel le nom de fichier? (cel.value)

Oups, vraiment désolé, c'est moi qui ai fait une boulette

le code corrigé :

Sub TestDate()

    Dim Plage As Range
    Dim Cel As Range
    Dim Fichier As String
    Dim LaDate As Date
    Dim Nb As Long

    With ActiveSheet: Set Plage = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In Plage

        Fichier = "C:\Users\Public\Documents\" & Cel.Value & ".tif"

        If Dir(Fichier) = "" Then

            MsgBox "Le fichier '" & Cel.Value & ".tif" & "' n'existe pas dans le dossier !"

        Else

            LaDate = DateValue(FileDateTime(Fichier))
            If Cel.Offset(, 6).Value = LaDate Then Nb = Nb + 1

        End If

    Next Cel

    If Nb = Plage.Count Then

        With Plage.Font
           .ThemeColor = xlThemeColorAccent6
           .TintAndShade = -0.249977111117893
        End With

    Else

        With Plage.Font
            .Color = -16776961
            .TintAndShade = 0
        End With

    End If

End Sub

Merci Theze,

En effet, ça fonctionne mieux

J'ai modifié un peu la 1ère partie du code afin qu'il m'avertisse quel fichier n'est pas à la bonne date.

Cela fonctionne impec merci!

Pour la seconde partie, à savoir la mise en couleur, le code colorie en rouge toutes les lignes dès lors qu'il y en a une de fausse alors que je souhaiterais qu'il colorie uniquement celle où la date est incorrecte.

petite question en aparté : Comme fais tu pour insérer le code dans la discussion?

Bonjour,

En testant le dernier code que je t'ai donné, je me suis aperçu d'une bourde (que tu as apparemment corrigé !) à savoir que je n'avais pas inclus le nom du fichier :

LaDate = DateValue(FileDateTime(Fichier & Cel.Value & ".tif"))

donc voici le code avec la coloration individuelle des cellules :

Sub TestDate()

    Dim Plage As Range
    Dim Cel As Range
    Dim Fichier As String
    Dim LaDate As Date

    With ActiveSheet: Set Plage = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In Plage

        Fichier = "C:\Users\Public\Documents\" & Cel.Value & ".tif"

        If Dir(Fichier) = "" Then

            MsgBox "Le fichier '" & Cel.Value & ".tif" & "' n'existe pas dans le dossier !"

        Else

            LaDate = DateValue(FileDateTime(Fichier & Cel.Value & ".tif"))

            If Cel.Offset(, 6).Value = LaDate Then

                With Cel.Font
                   .ThemeColor = xlThemeColorAccent6
                   .TintAndShade = -0.249977111117893
                End With

            Else

                With Cel.Font
                    .Color = -16776961
                    .TintAndShade = 0
                End With

            End If

        End If

    Next Cel

End Sub

En ce qui concerne les balises CODE, tu cliques sur le bouton </> qui va inscrire les balises à l'endroit du curseur et c'est entre ces balises que tu colles ton code en faisant attention de ne pas supprimer un crochet !

C'est tout bon!

Sauf pour ta "bourde", le code fonctionnait très bien avant pour moi.

La fonction DateValue (FileDateTime(...) va bien récupérer le chemin la variable "fichier" dans laquelle est déjà définie le nom du fichier donc c'était bon (où j'ai peut être zappé quelques chose)

Merci pour l'astuce d'insertion de code, j'avais pas vu les options de mise en page

Merci encore pour ton aide, cette petite manip va nous être d'un grand secours dans la vérification de nos fichiers.

@+

content de t'avoir aidé