Macro couleur sans selection de la cellule

Résolu/Fermé
diabolo162 Messages postés 1002 Date d'inscription lundi 28 janvier 2008 Statut Membre Dernière intervention 9 octobre 2018 - 17 oct. 2011 à 11:09
diabolo162 Messages postés 1002 Date d'inscription lundi 28 janvier 2008 Statut Membre Dernière intervention 9 octobre 2018 - 17 oct. 2011 à 17:57
Bonjour,
Je sollicite votre aide car il me manque un petit bout de macro pour finaliser mon fichier excel.
La question a été aborder surement beaucoup de fois mais je n'arrive toujours pas a trouver ce que je recherche depuis plusieurs jours.....

exemple :Dans le fichier "Nor1" je compose mon menu
Dans le fichier "Création menu Normal" les cellules sont lié au fichier "Nor1".
J'ai une macro couleur qui s'exécute mais elle ne fonctionne que sur la sélection de la cellule et je voudrais que les couleurs se changent automatiquement (des que le texte de cellule change.
La macro couleur prend ses référence dans le fichier "MFC"

Je pense que je dois changer le "Private Sub Workbook_SheetChange" par autre chose mais je ne sais pas quoi?????

Voici ma macro :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Integer, j As Long, Mfc As FormatCondition, c As Range, Ws1 As Worksheet
On Error GoTo fin ' en cas de mauvaise manipulation, ça plante sur l'ordre suivant
Application.EnableEvents = False
Set Ws1 = Sheets("MFC")
For i = 1 To Target.FormatConditions.Count
Set Mfc = Target.FormatConditions(i)
If UCase(Left(Mfc.Formula1, 7)) = "=MA_MFC" Then
Ws1.Range("A1").Value = Target.Value
Set c = Nothing
For j = 2 To Ws1.Range("A65536").End(xlUp).Row
If Ws1.Range("A" & j) = True Then
Set c = Ws1.Range("A" & j)
Exit For
End If
Next j
If c Is Nothing Then Set c = Ws1.Range("A1")
c.Copy
Target.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
End If
Next i
Application.EnableEvents = True
fin:
On Error GoTo 0
End Sub

Fichier ci joint :

http://www.cijoint.fr/cjlink.php?file=cj201110/cij8axzf9D.xls

Merci beaucoup d'avance....

A voir également:

2 réponses

diabolo162 Messages postés 1002 Date d'inscription lundi 28 janvier 2008 Statut Membre Dernière intervention 9 octobre 2018 29
17 oct. 2011 à 15:00
désolé le code sera mieux la :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim i As Integer, j As Long, Mfc As FormatCondition, c As Range, Ws1 As Worksheet
    On Error GoTo fin ' en cas de mauvaise manipulation, ça plante sur l'ordre suivant
    Application.EnableEvents = False
    Set Ws1 = Sheets("MFC")
    For i = 1 To Target.FormatConditions.Count
        Set Mfc = Target.FormatConditions(i)
        If UCase(Left(Mfc.Formula1, 7)) = "=MA_MFC" Then
            Ws1.Range("A1").Value = Target.Value
            Set c = Nothing
            For j = 2 To Ws1.Range("A65536").End(xlUp).Row
                If Ws1.Range("A" & j) = True Then
                    Set c = Ws1.Range("A" & j)
                    Exit For
                End If
            Next j
            If c Is Nothing Then Set c = Ws1.Range("A1")
            c.Copy
            Target.PasteSpecial (xlPasteFormats)
            Application.CutCopyMode = False
        End If
    Next i
    Application.EnableEvents = True
fin:
    On Error GoTo 0
End Sub
0
diabolo162 Messages postés 1002 Date d'inscription lundi 28 janvier 2008 Statut Membre Dernière intervention 9 octobre 2018 29
17 oct. 2011 à 17:57
Il y a vraiment personne pour m'aider?snif
0