XL 2016 PROJET

MASSJIPE

XLDnaute Impliqué
Bonjour le forum
est il possible de faire changer de couleur une forme en fonction d'un N° par rapport à une liste déroulante
Ex Sur la photo il y à plusieurs forme avec un N° de couleur jaune quant je sélectionne le N° à partir de la liste déroulante la couleur de la forme qui correspond au N° passe du jaune au vert.
Si c'est réalisable à savoir il y aura plusieurs onglet
D'avance merci
 

Pièces jointes

  • TEST.xlsx
    20.3 KB · Affichages: 22

M12

XLDnaute Accro
Bonjour,

Un Test à voir,
Depuis l'onglet BDD, l'appui sur le bouton NOUVEAU VL, duplique l'onglet LATERAL GH

il reste à mettre à ta sauce pour un menu avec un inputbox pour nommer le nouvel onglet
 

Pièces jointes

  • TEST (7).xlsm
    37.1 KB · Affichages: 25

M12

XLDnaute Accro
Re,
A tester
Pour que le bon fonctionnement
la liste des N° doit toujours se trouver en colonne L, à partir de la ligne 2 jusqu'à .....
les NOMS des formes doivent être nommées avec le N° correspondant (Voir sur les deux onglets déjà présents)
 

Pièces jointes

  • TEST (7) (1).xlsm
    479.7 KB · Affichages: 21

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à MASSJIPE, M12 ;),

Un double-clique sur la cellule C1 repasse toutes les étiquettes en vert.

Le code principal est dans module1:
VB:
Sub DuVertAuJaune()
Dim xsp As Shape, xt

  On Error Resume Next
  With ActiveSheet
    On Error Resume Next
    For Each xsp In .Shapes
      xt = "": xt = xsp.TextFrame2.TextRange.Text
      If xt <> "" And CInt(xt) = .Range("d1") Then xsp.Fill.ForeColor.RGB = RGB(255, 255, 0)
    Next xsp
    On Error GoTo 0
  End With
End Sub

Sub ReInit()
Dim xsp As Shape, xt

  On Error Resume Next
  With ActiveSheet
    On Error Resume Next
    For Each xsp In .Shapes
      xt = "": xt = xsp.TextFrame2.TextRange.Text
      If IsNumeric(xt) Then xsp.Fill.ForeColor.RGB = RGB(127, 255, 0)
    Next xsp
    On Error GoTo 0
  End With
End Sub

Pour chaque feuille concernée, coller le code suivant dans le module de code de la feuille (on peut aussi dupliquer une feuille existante):
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("d1")) Is Nothing Then DuVertAuJaune
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("c1")) Is Nothing Then
    Cancel = True: ReInit
  End If
End Sub
 

Pièces jointes

  • MASSJIPE- couleur formes- v1.xlsm
    239.6 KB · Affichages: 25
Dernière édition:

Discussions similaires

Réponses
2
Affichages
243

Statistiques des forums

Discussions
312 928
Messages
2 093 697
Membres
105 787
dernier inscrit
BABOU79