diabolo162
XLDnaute Nouveau
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 "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?????
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 "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?????
Code:
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