Affecter la valeur d'une cellule à un shape par VBA

Bonsoir,

Je bloque sur une macro et je fais donc appel à vous tous :)

J'ai un programme qui me permet de créer une feuille Excel avec des données que l'on peut filtrer. Je ne pourrais pas agir sur cette feuille car elle est créée à partir d'un autre classeur EXCEL avec la fonction Add.

J'aurais souhaité dans le Shape "ticket" de couleur orangé, afficher la valeur contenue dans la cellule Z1 qui fluctue en fonction des filtres appliqués, le tout, en passant obligatoirement par VBA.

Sans VBA, j'aurais sélectionné le SHAPE et dans la barre de formule j'aurais écrit =Z1 (j'ai fait le test avec le shape en vert et je voudrais ce même résultat avec le shape orangé).

Comment faire cette manip par VBA ? Je bloque sur cette ligne :

.TextFrame.Characters.Text = ActiveSheet.Range("Z1") & " résultat(s)"

Set myDocument = ActiveSheet
myDocument.Shapes.AddShape(msoShapePlaque, 1100, 10, 150, 30).Name = "ticket"
With ActiveSheet.Shapes("ticket")
.TextFrame.Characters.Text = ActiveSheet.Range("Z1") & " résultat(s)"
.TextFrame.Characters.Font.ColorIndex = 1
.TextFrame.Characters.Font.Bold = True
.Fill.ForeColor.RGB = RGB(250, 127, 54)
.TextFrame.Characters.Font.Size = 14

Merci à vous :)

PS: Je poste un exemple de mon fichier EXCEL

JB

Bonsoir JeanBaptisteP, bonsoir à tous,

Voici le code légèrement modifié qui fait ce qu'on lui demande.

Ne pas oublier de virer tous les shapes "ticket" qui se trouvent dans le volet sélection. J'ai rajouté une procédure qui les efface.

Sub Bouton1_Cliquer()
ActiveSheet.Range("Z1").FormulaLocal = "=SOUS.TOTAL(103;B3:B1048576)"
Set mydocument = ActiveSheet
Résultat = mydocument.Range("Z1").Value '& " résultat(s)"
    For Each s In mydocument.Shapes
    If s.Name = "ticket" Then s.Delete
    Next s
mydocument.Shapes.AddShape(msoShapePlaque, 1100, 10, 150, 30).Name = "ticket"
With mydocument.Shapes("ticket")
.TextFrame2.TextRange.Text = Résultat 'ActiveSheet.Range("Z1") & " résultat(s)"
.TextFrame.Characters.Font.ColorIndex = 1
.TextFrame.Characters.Font.Bold = True
.Fill.ForeColor.RGB = RGB(250, 127, 54)
.TextFrame.Characters.Font.Size = 14
End With
End Sub

Bonne fin de soirée.

A+

AL 22

Bonsoir AL22,

Merci beaucoup pour votre réponse. J'ai essayé votre code mais ce que j'aurais aimé obtenir, c'est que le résultat s'actualise en temps réel en fonction des filtres appliqués. Si je filtre les données j'aimerais que la valeur dans le shape "ticket" soit actualisée, le tout avec VBA. Est-ce possible?

Plus clairement, existe t-il un code VBA qui correspond à la formule =Z1 pour un shape ?

Merci beaucoup :)

JB

Re,

Une "bricole" qui fonctionne en :

• Mettant vos données sous forme de tableau structuré

• Mettant ce code dans le module de la feuille "laposte_commnouv" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Bouton1_Cliquer
End Sub

• Modifiant le code du module1 par celui ci :

Sub Bouton1_Cliquer()
If Not ActiveSheet.AutoFilter Is Nothing Then
ActiveSheet.Range("Z1").FormulaLocal = "=SOUS.TOTAL(103;B3:B1048576)"
Set mydocument = ActiveSheet
Résultat = mydocument.Range("Z1").Value '& " résultat(s)"
    For Each s In mydocument.Shapes
    If s.Name = "ticket" Then s.Delete
    Next s
mydocument.Shapes.AddShape(msoShapePlaque, 1100, 10, 150, 30).Name = "ticket"
With mydocument.Shapes("ticket")
.TextFrame2.TextRange.Text = Résultat 'ActiveSheet.Range("Z1") & " résultat(s)"
.TextFrame.Characters.Font.ColorIndex = 1
.TextFrame.Characters.Font.Bold = True
.Fill.ForeColor.RGB = RGB(250, 127, 54)
.TextFrame.Characters.Font.Size = 14
End With
End If
End Sub

Sur le principe : déclencher un évènement (en filtrant le tableau) qui sera répercuté et déclenchera la macro de changement.

La seule contrainte consiste à re-cliquer dans le tableau pour déclencher le changement, alors le shape s'actualise bien au clic à droite.

Petite démo

J'espère que cela vous conviendra.

A+

AL 22

Re,

Oui c'est une possibilité, cela fonctionne même cela aurait été l'idéal de se passer du click dans une case à la fin pour actualiser le résultat dans le shape.

Je pensais ajouter Range("A2").Select; par exemple pour éviter ce fameux click mais cela ne fonctionnera pas, dommage.

Si d'autres membres ont une idée je suis preneur mais merci beaucoup AL 22 pour cette proposition qui fonctionne malgré tout :)

JB

Bonjour JeanBaptisteP, bonjour à tous,

Je reviens à la charge avec cette macro dans la feuille "laposte_commnouv" qui permet d'actualiser instantanément le shape "ticket". Elle est plus académique.

Plus besoin de la macro "Bouton1_Cliquer", on peut l'effacer si les attributs du shape sont fixés (couleur, police,...).

Option Explicit

Private Sub Worksheet_Calculate()

Dim mydocument As Worksheet
Dim Résultat As Integer

Set mydocument = Sheets("laposte_commnouv")

Résultat = mydocument.Range("Z1").Value

    mydocument.Shapes("ticket").TextFrame2.TextRange.Text = Résultat

End Sub

Voilà.

Bonne journée à tous.

AL 22