Macro couleur sans selection de la cellule

Résolu
diabolo162 Messages postés 1039 Statut Membre -  
diabolo162 Messages postés 1039 Statut Membre -
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....

2 réponses

  1. diabolo162 Messages postés 1039 Statut Membre 29
     
    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
  2. diabolo162 Messages postés 1039 Statut Membre 29
     
    Il y a vraiment personne pour m'aider?snif
    0