Extraire le texte d'un bouton dans une cellule

Le 09/12/2021 à 23:16

Bonjour,

J'ai des boutons avec un texte fixe qui change de couleur (4).

J'aimerais que le texte des boutons soit réparti en fonction de la couleur du bouton quand je clique sur le bouton final de validation.

(Pour le moment ce bouton de validation permet de compter le nombre de bouton de chaque couleur.)

L'idée serait par exemple :

Bouton vert : texte1,texte2,texte5

Bouton orange : texte3,texte6

Bouton rouge : texte4

Bouton gris : texte7,texte8

J'ai essayé mais ça ne fonctionne pas.

Sub TapMe()
  Dim TargetButton As Shape, ButtonVal As Long
  Dim MaxNo As Long
  MaxNo = 4     '
  Set TargetButton = Application.ActiveSheet.Shapes(Application.Caller)
  ButtonVal = val(TargetButton.AlternativeText)
  ButtonVal = ButtonVal + 1
  If ButtonVal > MaxNo Then ButtonVal = 1
   TargetButton.Fill.ForeColor.rgb = Application.ActiveSheet.Cells(ButtonVal, 2).Interior.Color
    TargetButton.AlternativeText = ButtonVal
End Sub

J'ai accès au fichier demain, j'éditerai pour le mettre ici. Merci de votre aide

20classeur11.xlsm (33.12 Ko)
Le 10/12/2021 à 10:33

Edit du post avec le ficher en piece jointe

Le 10/12/2021 à 11:48

Bonjour,

Il y a deux questions il me semble.

1. dans votre fichier vous parlez de récupérer le nom du text qui se trouve dans le bouton et de la mettre en H7
2 dans votre demande, c'est attribuer un nom de bouton suivant la couleur

Pour le point 1 je peux vous donner le code
Pour le point 2, à priori il faut connaitre au préalable les couleurs que vous pouvez mettre dans ces boutons

Dites moi

Le 10/12/2021 à 12:15

Bonjour Dan merci pour votre réponse rapide.

Je me suis peut etre mal exprimé. Je pense que nous sommes d'accord sur le 1) mais pas le 2).

Le texte des boutons est fixe. test1 restera test1. Chaque bouton change de couleur (4couleurs) si l'on clique dessus.

Une fois que j'ai les couleurs souhaitées, je clique sur le bouton bleu du bas à l'aide de ce code :

Sub countButtonsByColor()
    Const cBtnName = "btnCommand"
    Dim nbR As Integer
    Dim nbV As Integer
    Dim nbJ As Integer
    Dim nbP As Integer
    Dim obj As Shape

    'On boucle sur tous les objets shape de la feuille
    For Each obj In ActiveSheet.Shapes
        If Left(obj.Name, Len(cBtnName)) = cBtnName Then
            Select Case obj.Fill.ForeColor.RGB
              Case Is = RGB(96, 224, 64) 'vert
                  nbV = nbV + 1
              Case Is = RGB(255, 0, 32) 'rouge
                  nbR = nbR + 1
              Case Is = RGB(255, 160, 0) 'orange
                          nbJ = nbJ + 1
            Case Is = RGB(160, 128, 160) 'violet
                  nbP = nbP + 1
          End Select
      End If
    Next obj

    'On valorise les cellules I
    ActiveSheet.Range("H5").Value = nbV
    ActiveSheet.Range("H18").Value = nbR
    ActiveSheet.Range("H31").Value = nbJ
    ActiveSheet.Range("H44").Value = nbP
    End Sub

J'obtiens la somme de chaque couleur dans les cellules ciblées.

Et je voudrais donc en plus sur ce bouton de validation y rajouter l'extraction du texte si possible.

Par exemple, en H7 l'extraction des textes des boutons qui seront en vert (qui peut etre variable selon les boutons verts choisis).

Avec l'exemple je ferais pareil pour les oranges, rouges, et violets.

Encore merci de votre aide

Le 10/12/2021 à 12:31

Le texte des boutons est fixe. test1 restera test1. Chaque bouton change de couleur (4couleurs) si l'on clique dessus.

Ok je viens de voir

Une fois que j'ai les couleurs souhaitées, je clique sur le bouton bleu du bas à l'aide de ce code :

Là votre bouton bleu pourrait être directement liés au code car je vois qu'il est lié à une autre macro qui ne fait qu'appel au code que vous postez

Par exemple, en H7 l'extraction des textes des boutons qui seront en vert (qui peut etre variable selon les boutons verts choisis).

Ok mais vous allez toujours mettre les textes en H7 ?

Le 10/12/2021 à 12:43

Je vous joins une nouvelle mise à jour du fichier.

Les textes qui sont dans les boutons verts seront extraits en H7

Les textes qui sont dans les boutons oranges seront extraits en H20

Les textes qui sont dans les boutons rouges seront extraits en H35

Les textes qui sont dans les boutons violets seront extraits en H50

Ces cellules sont fixes.

26classeur11.xlsm (34.07 Ko)
Le 10/12/2021 à 12:51

Ok je vais voir mais par contre pourquoi vous fusionnez les lignes comme cela ???
C'est toujours des problèmes à un moment ou un autre avec VBA

C'est dingue toujours cette habitude que je vois alors qu'il suffit d'agrandir une ligne ou élargir une colonne. Dans votre fichier vous auriez tout au plus 4 à 5 colonnes et quelques lignes.

Les données sont bien à mettre dans les cellules Violet ?
Le fichier posté est votre original ?

Le 10/12/2021 à 13:37

Voici le code
Il vous faut défusionner les cellules H7, H22, H37 et H52 sans quoi cela va buguer.

Sub Macro1()
Dim sh As Shape

ActiveSheet.Range("H7, H22, H37, H52").ClearContents

For Each sh In ActiveSheet.Shapes
    With ActiveSheet.Shapes.Range(sh.Name).Fill.ForeColor
        Select Case RGB(Int(.RGB Mod 256), Int((.RGB Mod 65536) / 256), Int(.RGB / 65536))
            Case Is = RGB(96, 224, 64) 'vert
                With ActiveSheet
                    .Range("H7") = .Range("H7") & ", " & .Shapes.Range(sh.Name).TextFrame.Characters.Text
                End With
            Case Is = RGB(255, 0, 32) 'rouge
                With ActiveSheet
                    .Range("H22") = .Range("H22") & ", " & .Shapes.Range(sh.Name).TextFrame.Characters.Text
                End With
            Case Is = RGB(255, 160, 0) 'orange
                With ActiveSheet
                    .Range("H37") = .Range("H37") & ", " & .Shapes.Range(sh.Name).TextFrame.Characters.Text
                End With
            Case Is = RGB(160, 128, 160) 'violet
                With ActiveSheet
                    .Range("H52") = .Range("H52") & ", " & .Shapes.Range(sh.Name).TextFrame.Characters.Text
                End With
            End Select
    End With
Next sh

End Sub

Après comme je vous ai dit avant, essayez de mettre votre tableau sur 4 ou 5 colonnes. Pour les lignes, on sait réduire à une dizaine max

Cordialement

Le 10/12/2021 à 13:38

C'est vrai pour les cellules fusionnées et comme vous dite c'est une facheuse habtiude.

J'ai donc modifié la mise en page pour retirer les cellules fusionnées.

Je vais tester de suite votre code et vous remercie pour vos conseils!

Encore merci de votre aide

Le 10/12/2021 à 13:46

Merci beaucoup @Dan pour votre rapidité et votre aide.

Le code fonctionne parfaitement. Il commence l'extraction par une virgule mais il récupère bien les textes.
J'ai tout réuni sous une meme macro, comptage et extraction, ça fonctionne

ff
Le 10/12/2021 à 16:16

Oui pour la virgule c'est normal dans le code
Mais on peut arranger cela avec une condition si cela vous dérange

Cordialement

Le 10/12/2021 à 22:23

Si c'est faisable je voudrais bien, mais c'est du bonus.. C'est déjà très très bien que cela fonctionne parfaitement

Encore merci Dan

Le 11/12/2021 à 09:03

vous pouvez ajouter une condition IF

exemple pour le Vert --> remplacez

.Range("H7") = .Range("H7") & ", " & .Shapes.Range(sh.Name).TextFrame.Characters.Text

par

If .Range("H7") = "" Then
    .Range("H7") = .Shapes.Range(sh.Name).TextFrame.Characters.Text
Else: .Range("H7") = .Range("H7") & ", " & .Shapes.Range(sh.Name).TextFrame.Characters.Text
End If

le IF est à ajouter pour chaque cas de couleur

Il y aurait certainement encore possibilité d'améliorer en simplifiant mais bon, je me base sur votre fichier posté

Cordialement

Rechercher des sujets similaires à "extraire texte bouton"