code mise à jour de plusieurs pages

[spoky]

Bonjour à tous,
voilà ce qui m'amène.
j'ai un code vba qui met à jour une seule page et j'aimerai étendre ce code à un ensemble de pages d'un même document
voici ce code :
la condition c'est que si des cellules contiennent la valeur "p", remplacer par la valeur "fv" avec la couleur rouge.

Private Sub CB_MettreAjour_Click()
MsgBox "VOUS ALLER METTRE A JOUR LES CONTROLES NON REALISES A CETTE DATE, voulez-vous vraiment continuer ", vbYesNo + vbExclamation, "EADS ST - MAINTENANCE DU SITE BLB"
If vbYes Then
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim Cell As Range
For Each Cell In Range("C7:BB600")
If Cell.Value = "p" Then
If Cells(6, Cell.Column).Value < Range("BE1").Value Then
Cell.Value = "FV"
Cell.Interior.ColorIndex = 3
End If
End If
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
If vbNo Then
UF_Controle.Hide
Application.ScreenUpdating = True

End If
End If
End Sub

Merci d'avance et bonne journée
SPOKY

 

[MichD]

Re : code mise à jour de plusieurs pages

Bonjour,

Essaie comme ceci :


'----------------------------------------------------------

Private Sub CB_MettreAjour_Click()
Dim Sh As Worksheet, Adr As String, Trouve As Range

'Cette ligne est présente afin de permettre à la procédure
'de sortir de la boucle sans provoquer une erreur
On Error Resume Next

If MsgBox("VOUS ALLER METTRE A JOUR LES CONTROLES NON REALISES A CETTE DATE, " & _
        "   voulez-vous vraiment continuer ", vbYesNo + vbExclamation, _
        "EADS ST - MAINTENANCE DU SITE BLB") = vbYes Then

    Application.ScreenUpdating = False
    For Each Sh In Worksheets
        With Sh
            .Unprotect
            With .Range("C7:BB600")
                Set Trouve = .Find(What:="P", LookIn:=xlValues, Lookat:=xlPart)
                If Not Trouve Is Nothing Then
                    Adr = Trouve.Address
                    Do
                        If Sh.Cells(6, Trouve.Column) < Range("BE1").Value Then
                            With Trouve
                                .Value = "FV"
                                .Interior.Color = vbRed
                            End With
                        End If
                        Set Trouve = .FindNext(Trouve)
                    Loop Until Trouve Is Nothing Or Trouve.Address = Adr
                End If
            End With
            .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        End With
    Next
    Application.ScreenUpdating = True
Else
    UF_Controle.Hide
End If
End Sub

'----------------------------------------------------------

 

[spoky]

Re : code mise à jour de plusieurs pages

MERCI pour ta réponse rapide, je m'empresse de l'essayer et je te tiens au courant.
bonne soirée.

 

[spoky]

Re : code mise à jour de plusieurs pages

Re bonjour,
j'ai essayé de faire fonctionner ce code aujourd'hui, sans succès.
j'essaie de t'envoyer un fichier, peut-être que ce sera plus explicite.
Apparemment, le fichier est bien parti, j'espère que tu pourras en tirer quelque chose.
Merci pour ton aide bonne soirée
spoky

 

[MichD]

Re : code mise à jour de plusieurs pages

J'ai modifié très légèrement la procédure pour tenir compte que tu avais une feuille "menu".

Je n'ai rien testé d'autre...Comme la procédure évalue des conditions pour modifier certaines de la feuille, comme il n'y a pas de donnée dans le classeur, il est difficile de tester...

Private Sub CB_MettreAjour_Click()
Dim Sh As Worksheet, Adr As String, Trouve As Range

'Cette ligne est présente afin de permettre à la procédure
'de sortir de la boucle sans provoquer une erreur
On Error Resume Next

If MsgBox("VOUS ALLER METTRE A JOUR LES CONTROLES NON REALISES A CETTE DATE, " & _
         "   voulez-vous vraiment continuer ", vbYesNo + vbExclamation, _
         "EADS ST - MAINTENANCE DU SITE BLB") = vbYes Then

    Application.ScreenUpdating = False
    For Each Sh In Worksheets
         With Sh
            If Sh.Name <> "MENU" Then
                .Unprotect
                With .Range("C7:BB600")
                    Set Trouve = .Find(What:="P", LookIn:=xlValues, Lookat:=xlPart)
                    If Not Trouve Is Nothing Then
                        Adr = Trouve.Address
                        Do
                            If Sh.Cells(6, Trouve.Column) < Range("BE1").Value Then
                                With Trouve
                                    .Value = "FV"
                                    .Interior.Color = vbRed
                                End With
                            End If
                            Set Trouve = .FindNext(Trouve)
                        Loop Until Trouve Is Nothing Or Trouve.Address = Adr
                    End If
                End With
                .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            End With
        End With
    Next
    Application.ScreenUpdating = True
Else
     UF_Controle.Hide
End If
End Sub

 

[spoky]

Re : code mise à jour de plusieurs pages

merci je test ça aujourd'hui et je te tiens au courant.
bonne journée.

 

[spoky]

Re : code mise à jour de plusieurs pages

bonsoir, j'ai testé ton premier code et il marche. le seul problème c'est qu'il change toutes les cellules ayant pour valeur "p" alors qu'il devrait modifier que les cellules ayant la valeur "p" dans les colonnes dont la valeur est inférieure au n° de semaine en cours. Je te mets en pièce jointe le fichier avec quelques explications.

 

[MichD]

Re : code mise à jour de plusieurs pages

Pour ce petit problème, je ne fais pas la publication d'un autre fichier...

Dans la macro, tu modifies cette ligne de code : (xlpart pour xlwhole)

Set Trouve = .Find(What:="p", LookIn:=xlValues, Lookat:=xlPart)

PAR

Set Trouve = .Find(What:="p", LookIn:=xlValues, Lookat:=xlWhole)

 

[spoky]

Re : code mise à jour de plusieurs pages

Bonjour,
je n'arrive pas à faire fonctionner ce code.
peux-tu me dire ce qui ne va pas .
Merci et désolé de te déranger encore.

Private Sub MettreAjour_Click()
Dim Sh As Worksheet, Adr As String, Trouve As Range

'Cette ligne est présente afin de permettre à la procédure
'de sortir de la boucle sans provoquer une erreur
On Error Resume Next

If MsgBox("VOUS ALLER METTRE A JOUR LES CONTROLES NON REALISES A CETTE DATE, " & _
" voulez-vous vraiment continuer ", vbYesNo + vbExclamation, _
"EADS ST - MAINTENANCE DU SITE BLB") = vbYes Then

Application.ScreenUpdating = False
For Each Sh In Worksheets
With Sh
If Sh.Name <> "MENU" Then
.Unprotect
With .Range("C7:BB600")
Set Trouve = .Find(What:="P", LookIn:=xlValues, Lookat:=xlWhole)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do
If Sh.Cells(6, Trouve.Column) < Range("BE1").Value Then
With Trouve
.Value = "FV"
.Interior.Color = vbRed
End With
End If
Set Trouve = .FindNext(Trouve)
Loop Until Trouve Is Nothing Or Trouve.Address = Adr
End If
End With
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End With
Next
Application.ScreenUpdating = True
Else
UF_Controle.Hide
End If
End With

End Sub

 

[MichD]

Re : code mise à jour de plusieurs pages

C'est à toi d'explique ce qui ne va pas. Qu'est-ce qui ne fonctionne pas. Quel est le problème que tu rencontres? À toi de décrire la situation. Moi, je n'ai pas ce fichier avec des données...

 

[spoky]

Re : code mise à jour de plusieurs pages

Bonjour,
Dans le fichier que je t'ai envoyé, les pages ont un tableau avec des cellules de validation. chaque cellule a trois niveau de validation. si "p" couleur bleu, si "r" couleur vert.
si tu rentre des valeur "p" dans des cellules à gauche et à droite de la colonne du n° de semaine en cours "la cellule en jaune" et que tu clic sur le bouton "mettre à jour" de la page "menu", normalement seules les cellules en bleu "p" à gauche de la colonne du n° de semaine en cours devraient passer en rouge avec la valeur "fv". Ce n'est pas le cas, toutes les cellules bleues de toute la feuille passent en rouge. J'espère que je me suis bien expliqué. Désolé encore pour ce dérangement.
Bonne journée.

 

[MichD]

Re : code mise à jour de plusieurs pages

Tu connais l'application que tu es en train de développer...

La question du début de ce fil demandait de rechercher les cellules contenant "P" et remplacer cette valeur pour "FV" et y ajoutant la couleur rouge en respectant cette condition de la macro que tu avais émis dans la procédure que tu avais émise :
If Cells(6, Cell.Column).Value < Range("BE1").Value Then

Si tu veux que je modifie la procédure que je t'ai soumise, je veux avoir les conditions précises qu'elle doit respecter pour effectuer la substitution de P en FV.

Il me semble qu'il doit y avoir moyen d'être plus claire que cela :

si tu rentres des valeurs "p" dans des cellules à gauche et à droite de la colonne du n° de semaine en cours "la cellule en jaune"

**** Dans ta feuille, nomme la plage de cellules qui peut contenir la valeur P, chaque cellule dans Excel a une adresse précise, ce n'est pas pour rien!

à gauche et à droite de la colonne du n° de semaine en cours "la cellule en jaune"

**** Je ne vois pas de numéro de cellules dans ta feuille, est-ce si difficile de donner l'adresse de ces cellules?

En fait, tout ton texte pour moi c'est du chinois! Ça ne me tente pas d'étudier ton programme, connaître à fond ce qu'il fait...etc. Je n'ai pas ce temps... Je te proposais seulement une petite aide pour un petit bout de code.

Comme je n'ai pas conçu de programme, ce n'est pas du verbiage dont j'ai besoin, mais les conditions en clair.

Condition 1 : Si telle cellule (adresse) prend tel valeur -> voici ce qui doit de passer à telle autre cellule.

Condition 2 : Si ... Alors...

Condition 3 : Si ... Alors ....

Désolé, je ne suis pas versé dans la littérature!

Je passe la main aux gens qui sont plus susceptibles de comprendre ta demande... Merci.

 

[spoky]

Re : code mise à jour de plusieurs pages

Je te comprend et je respect ton choix.
je tiens quand même à te remercier pour ta patience.
Je vais continuer à prospecter.