Microsoft 365 macro qui ne fonctionne pas pour colorisation d'une carte

Daniel200666 · Mardi à 19:28

bonsoir à tous
j'ai voulu refaire une carte qui se colorise automatiquement selon une macro qu'un gentil bienfaiteur de ce site m'avait proposé et qui fonctionnait bien
or, en faisant un copier-coller, la macro ne fonctionne pas
auriez vous la possibilité de vérifier la macro car je ne suis pas très à l'aise sur ce sujet, l'idée étant peut être de pouvoir prévoir, avec un bouton, l'actualisation de la carte
Sauf bien entendu s'il était possible, selon l'état du déploiement, d'actualiser la carte automatiquement
et là ce serait top !!!
Merci beaucoup à mon bienfaiteur !!!

job75 · Mercredi à 07:03

Bonjour Daniel200666, le forum,

Colorer les Shapes est simple :

VB:

Sub Colorer()
Dim F As Worksheet, s As Shape, i As Variant
Set F = Sheets("Liste CR") 'feuille de référence
For Each s In ActiveSheet.Shapes
    If s.Name Like "_CR*" Then
        i = Application.Match(Mid(s.Name, 4) & " - *", F.Columns(1), 0)
        If IsNumeric(i) Then s.Fill.ForeColor.RGB = F.Cells(i, 1).Interior.Color
    End If
Next
End Sub

Pour que la macro s'exécute automatiquement il suffit de placer celle-ci dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

VB:

Private Sub Worksheet_Activate()
Colorer 'lance la macro'
End Sub

Plus besoin de bouton, elle se déclenche quand on active la feuille.

A+

Daniel200666 · Mercredi à 18:53

job75 à dit:
Bonjour Daniel200666, le forum,

Colorer les Shapes est simple :

VB:

Sub Colorer() Dim F As Worksheet, s As Shape, i As Variant Set F = Sheets("Liste CR") 'feuille de référence For Each s In ActiveSheet.Shapes If s.Name Like "_CR*" Then i = Application.Match(Mid(s.Name, 4) & " - *", F.Columns(1), 0) If IsNumeric(i) Then s.Fill.ForeColor.RGB = F.Cells(i, 1).Interior.Color End If Next End Sub

Pour que la macro s'exécute automatiquement il suffit de placer celle-ci dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

VB:

Private Sub Worksheet_Activate() Colorer 'lance la macro' End Sub

Plus besoin de bouton, elle se déclenche quand on active la feuille.

A+

bonsoir @job75 , merci pour ce travail mais vraiment désolé, je n'arrive pas à le faire correctement je pense ... j'ai aussi essayé de prévoir une mise à jour automatique des couleurs sur le premier onglet avec une règle de colorisation selon la valeur mais je n''y arrive pas ...pourriez vous m'aider à remettre tout cela à plat, svp ? Merci

job75 · Mercredi à 19:16

Daniel200666 à dit:
je n'arrive pas à le faire correctement je pense ...

Ci-joint 2 fichiers, le 1er pour lancer la macro en cliquant sur le bouton, le 2ème par activation de la feuille "Carte CR".

Pour le 1er onglet les couleurs doivent être mises ou modifiées manuellement.

job75 · Jeudi à 06:26

Bonjour le forum,

Bon je m'intéresse maintenant à la modification des couleurs du 1er onglet "Liste CR".

Voyez les listes de validation en colonne B et cette macro dans le code de la feuille :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, i As Variant
Set Target = Intersect(Target, Range("B2:B" & Rows.Count), UsedRange)
If Target Is Nothing Then Exit Sub
Set P = Sheets("DATA").[A1].CurrentRegion 'plage de référence
For Each Target In Target 'si entrées multiples (copier-coller)
    i = Application.Match(Target, P.Columns(1), 0)
    If IsError(i) Then
        Target(1, 0).Resize(, 2).Interior.ColorIndex = xlNone
        Target(1, 2) = ""
    Else
        Target(1, 0).Resize(, 2).Interior.Color = P(i, 1).Interior.Color
        Target(1, 2) = P(i, 2)
    End If
Next Target
End Sub

Les couleurs et les "Oui/Non" en colonne C sont appliquées quand on modifie les valeurs en colonne B.

Quel est l'intérêt de la colonne C ?

Voyez aussi la feuille "DATA" et les couleurs de référence.

A+

job75 · Jeudi à 06:42

Pour le fun j'ai testé la macro précédente en recopiant la plage 2:40 sur les lignes 41:3901.

Chez moi elle s'exécute en 2,5 secondes.

Microsoft 365 macro qui ne fonctionne pas pour colorisation d'une carte

Daniel200666

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Daniel200666

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Discussions similaires

Microsoft 365 macro qui ne fonctionne pas pour colorisation d'une carte

Daniel200666

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Daniel200666

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency