XL 2016 PROJET

MASSJIPE · 26 Février 2017

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

M12 · 26 Février 2017

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

MASSJIPE · 26 Février 2017

Re
merci pour l'aide
Pour l'onglet latéral gh fonctionne à merveille reste pour les autres onglets que ca pose problème car le N° sont diffèrent

M12 · 26 Février 2017

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)

mapomme · 26 Février 2017

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

MASSJIPE · 26 Février 2017

Merci à vous deux
je fait un essais sur le fichier original demain
un bon Week end

MASSJIPE · 26 Février 2017

Re
J'ai un soucis lorsque les N° qui sont dans le désordre et 4 chiffres

M12 · 26 Février 2017

Re,
c'est pas le désordre, c'est les N° qui ne se suivent pas
1001 - 2002
devrait être 1001 - 1002
Mais j'ai compris ta demande et je regarderai cette AM,en ajoutant une colonne numérotée de 1 à Nb X

mapomme · 26 Février 2017

Re,

Avec ma macro du message #5, ça fonctionne quelque soit le nombre de chiffres et dans n'importe quel ordre.

MASSJIPE · 26 Février 2017

est il possible que la couleur disparaisse après chaque changement de N° sans passer par le double clic en C1

mapomme · 26 Février 2017

Re,

MASSJIPE à dit:
est il possible que la couleur disparaisse après chaque changement de N° sans passer par le double clic en C1

Voir le fichier v2 joint (la possibilité du double-clique sur C1 pour tout repasser en vert est conservée)

MASSJIPE · 26 Février 2017

Re
au fil de l'eau et en testant sur l'original et aussi des codes à chiffre et lettre qui dans ce cas ne fonctionne pas

mapomme · 26 Février 2017

Re,

MASSJIPE à dit:
Re
au fil de l'eau et en testant sur l'original et aussi des codes à chiffre et lettre qui dans ce cas ne fonctionne pas

Normal, le code a été conçu pour des étiquettes avec des chiffres.

M12 · 26 Février 2017

Re,
Une autre version avec prise en charge chiffre et lettre et un bouton qui renomme les Shapes par le nom de la liste

mapomme · 26 Février 2017

Re, salut M12

Une version qui accepte des codes quelconques.

XL 2016 PROJET

XLDnaute Impliqué

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Impliqué

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires