Comment récupérer le texte d'un rectangle ?

sourcier08

XLDnaute Occasionnel
Bonjour à tous,

J'ai une feuille avec 12 rectangles (Rectangle à coins arrondis 1, 2, 3,...), que j'ai créé et qui me servent de boutons.
Sur ces boutons, j'ai mis du texte et j'aimerai récupérer celui-ci lorsque je clique sur un bouton.

Merci d'avance pour l'aide que vous m'apporterez à résoudre ce problème.
 

chris

XLDnaute Barbatruc
Bonjour

J'imagine que les boutons appellent une procédure VBA.

Voir application.caller...

Edit : je complète car ma solution est différence de celle de pierrejean (auquel j'adresse 1000 et 1 bises)

J'ai nommé les boutons, car il y a toujours des problèmes avec la localisation chez MS, puis associé une même procédure
Code:
Libellé = Shapes(Application.Caller).TextFrame2.TextRange
.
 
Dernière édition:

sourcier08

XLDnaute Occasionnel
Bonjour et merci à vous deux.

Après avoir regarder ce que vous me proposiez, j'ai réfléchi au moyen le plus simple même si ce n'est pas ce que je voulais faire, le résultat je l'obtiens avec ce bout de code :

VB:
NomShape = Application.Caller
Set plage = Sheets("Divers").Range("A4:A14")

For Each cel In plage
    If cel = NomShape Then
        Sheets("Divers").Range("D6") = cel.Offset(0, 8)
        feuille = Replace(cel.Offset(0, 9), " ", "")
        Sheets(feuille).Visible = True
        Sheets(feuille).Select
    End If
Next cel

Merci encore pour l'aide qui m'a permis de pousser ma réflexion plus loin et ainsi trouver une solution acceptable à mon problème !
 

job75

XLDnaute Barbatruc
Bonjour à tous,

Juste une remarque sur la macro de pierrejean.

TexteFrame2, si je me souviens bien, n'existe qu'à partir d'Excel 2013.

TextFrame fonctionne sur toute version :
Code:
Sub Rectangleàcoinsarrondis1_Cliquer()
MsgBox ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
End Sub
A+
 

sourcier08

XLDnaute Occasionnel
Bonjour à tous,

Merci job75 pour cette correction fort utile.
"TextFrame2" me renvoyait une erreur 438

Chris, ta proposition me renvoyait "sub ou fonction non définie"

Du coup, j'ai réussi à adapter au plus court et directement sur ce que je souhaitais :

Je passe donc de :

VB:
NomShape = Application.Caller
Set plage = Sheets("Divers").Range("A4:A14")

For Each cel In plage
    If cel = NomShape Then
        Sheets("Divers").Range("D6") = cel.Offset(0, 8)
        feuille = Replace(cel.Offset(0, 9), " ", "")
        Sheets(feuille).Visible = True
        Sheets(feuille).Select
    End If
Next cel

t = Sheets.Count
For s = 1 To t
    If Sheets(s).Name <> "OP" & Sheets("Divers").Range("D6") Then
        Sheets(s).Visible = False
    ElseIf Sheets(s).Name = "OP" & Sheets("Divers").Range("D6") Then
        Sheets(s).Visible = True
    End If
Next s

à :

VB:
feuille = Replace(ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text, " ", "")

t = Sheets.Count
For s = 1 To t
    If Sheets(s).Name <> feuille Then
        Sheets(s).Visible = False
    ElseIf Sheets(s).Name = feuille Then
        Sheets(s).Visible = True
    End If
Next s


End Sub

Ce qui va me permettre de libérer du contenu (devenu inutile) dans l'onglet "Divers".

Merci à tous pour votre aide.
 

Discussions similaires

Réponses
3
Affichages
218

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG