Discussion :

[ericdev67]

Bonjour,

J'ai des boutons créés en "bouton formulaire". J'ai longtemps galéré, avant de m'aperçevoir dans le forum que la couleur de fond du bouton ne peut pas être changée....
Bon, bref, de toutes façons, il pleut....
En fait, j'arrive à changer la couleur du texte du bouton, ce que je cherche, c'est que lorsque je clique sur mon bouton, il "prend" la couleur du texte et la colle dans une cellule.

Un peu comme un copié-collé de la couleur.....

Des idées ???

Merci,
A+

[LeForestier]

Bonjour,
Des.. non, mais une.. oui

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub Bouton1_QuanClick()
    ActiveSheet.Shapes("Button 1").Select
    Range("I6").Interior.ColorIndex = Selection.Font.ColorIndex
End Sub

A+

[ericdev67]

Merci LeForestier,

Je te joins le code que j'utilise :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("c18:af63")) Is Nothing Then Exit Sub
 
 
If  x = "" Then
 
    Exit Sub
Else
    Target.Value = x
 
   x = ""
 
End If
 
End Sub
 
 
Sub Test_nom()
Range("A41").Select
    x = Application.Caller
 
End Sub

A partir d'une idée de Fring (rendons à César,....)

Le principe : je clique sur l'objet (la macro Test_nom), je "prends" son nom et je clique sur une cellule et miracle de la macro, le nom est inséré dans la cellule.
En fait, j'aimerais faire la même chose avec la couleur de l'objet (l'écriture, pas le motif car impossible apparement).

J'ai essayé d'utiliser ton code, enfin les instructions ("interiorcolor, colorindex,..."), combinés avec "target, application", j'ai essayé plusieurs combinaisons, sans succès....



Merci
A+

[LeForestier]

Un "bouton formulaire" n'active aucun événement de feuille, tu doit mettre cela directement dans la macro du bouton.
Target est un Range, autrement dit.. une cellule ou plage de cellule.
Précise.. c'est bien un bouton de la barre d'outils "Formulaire" ?
Mais il est possible que tu veuille "montrer" d'abord la cellule que tu veux modifier !! dans ce cas là..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim AncAdd As String
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    AncAdd = Target.Address
End Sub

Et dans la mocros liée au bouton...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub Bouton1_QuanClick()
    ActiveSheet.Shapes("Button 1").Select
    Range(AncAdd).Interior.ColorIndex = Selection.Font.ColorIndex
End

Tu dis.

[ericdev67]

Merci LeForestier,

oui, je me sers bien des boutons de formulaire auquel j'affecte ma macro "test_nom", le 'nom' du bouton est récupéré et lorsque je clique dans une cellule, le texte du 'nom' est mis.

Par contre, j'ai essayé ton code, il me répond : "la méthode 'Range' de l'objet '_Global' a échoué".

J'ai essayé avec mon code de récupérer la valeur de la couleur du texte pour pouvoir la récupérer lorsque je clique sur ma cellule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("c18:af63")) Is Nothing Then Exit Sub
If x = "" Then
       Exit Sub
Else
    Target.Value = x
    Selection.Interior.ColorIndex = y
    x = ""
End If
End Sub
 
 
Public x, y As String
Sub Test_nom()
Range("A41").Select
    x = Application.Caller
    y = Selection.Font.ColorIndex
 
End Sub

Et même là, ça ne fonctionne pas....il me donne -4142 en valeur de y.....

Merci,
A+

(juste, dans mon code, le "Range("A41") est de trop....)

skuz

[LeForestier]

Ok,j'ai compris, tu fais l'inverse, tu clic d'abord sur le bouton et ensuite sur la cellule que tu veux colorier.
Si ça fonctionne oublie pas
A+

[ericdev67]

Merci LeForestier,

J'ai déjà essayé dans tous les sens : je pensais au début que ça venait de là (=inversion), j'ai changé mais ça n'a rien donné....

Je mets un exemple en pièce jointe....

En fait, au début, je n'avais pas de soucis, je n'avais que 3 boutons et donc je mettais une mise en forme condionnelle, mais là, j'ai besoin de 8 boutons et donc d'une solution pour changer les cellules de couleur....

Je cherche, je cherche, j'essaye en essayant de récupérer le numéro de couleur..un peu comme le "target.value", mais ça ne donne rien....

Merci
A+

[LeForestier]

Sans bouton ? si ça convient pas tu dit je ferais avec des boutons...

[ericdev67]

Super génial LeForestier, merci,

J'ai un peu "bidouillé" ton code, je vais pouvoir l'adapter.

Par contre, dans mon code initial, et surtout pour éviter des clics trop "rapides", j'avais mis comme condition qu'il fallait à chaque fois cliquer sur l'objet pour avois sa valeur (x=" " à la fin du code).
Donc, j'ai essayé (voir la pièce jointe), ça fonctionne, mais en cas de "récidive" (= je clique sur une cellule sans avoir retapé sur la zone couleur), il y a un message d'erreur sur la macro. Je pense que j'ai mal positonné mon 'coul=""' et le 'text=""', je l'ai mis après le 'end if' et là ça coince tout de suite.
Avant le 'end if' ça marche 1 fois et après "récidive" message erreur sur la macro....

J'ai compris la logique de ton code, très simple et très efficace.

J'aime bien comprendre :
Le 'if target.count>1 then exit sub : je ne comprends pas....

Et la macro1(), elle sert à quoi ???, dans le doute, je l'ai supprimée et rien n'a changé....

A+

[ericdev67]

j'ai essayé différentes solutions, mais je n'arrive toujours pas à remettre à "" une fois que la couleur et le texte sont utilisés et j'ai toujours l'erreur sur le code.....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Dim Coul
Dim Txt As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B6:B13")) Is Nothing Then
        Coul = Target.Font.ColorIndex
        Txt = Target
    ElseIf Not Intersect(Target, Range("D4:D30")) Is Nothing Then
        If Coul < 1 Then Exit Sub
        Target = Txt
        Target.Interior.ColorIndex = Coul
        Target.Offset(0, 0) = Txt
        Target.Offset(0, 1).Font.ColorIndex = Coul
 
         Coul = ""
    Txt = ""
 
    End If
 
 
End Sub

je sais que 'txt=""' et 'coul=""' sont mal placés, mais je ne vois pas comment faire....

merci
A+

[ericdev67]

Ayé, j'ai enfin trouvé !!!!!

Merci à toi LeForestier ,

Tes idées m'ont aidé à trouver la bonne solution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim Coul
Dim Txt As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B6:B13")) Is Nothing Then
        Coul = Target.Font.ColorIndex
        Txt = Target
 
    ElseIf Not Intersect(Target, Range("D4:D30")) Is Nothing Then
    If Txt = "" Then Exit Sub
 
        If Coul < 1 Then Exit Sub
        Target = Txt
        Target.Interior.ColorIndex = Coul
        Target.Offset(0, 0) = Txt
        Target.Offset(0, 1).Font.ColorIndex = Coul
 
        Txt = ""
 
    End If
 
End Sub

Par contre, juste pour info et que je puisse mieux comprendre, pourquoi le '

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if target.count>1 then exit sub

, je ne comprends pas....

A+ pour de prochaines aventures ......

[LeForestier]

Re,
Pour éviter une erreur quand un bloc de cellule est sélectionner.
A+

[ericdev67]

ok merci LeForestier,

Tout devient clair !!!!!

A+ pour de prochaines aventures....