Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Le Module_ShowShape à importer dans le projet VBA.
Le Module_Test comme exemple de mise en œuvre.
Les principales caractéristiques:
Permet d'afficher un texte dans une Shape pour, par exemple, informer des étapes d'un traitement d'une macro. Cet texte affiché n'attend pas de réponse de l'utilisateur, c'est simplement une...
Bonjour Dudu2,
Merci pour cette petite application qui m'est bien utile car beaucoup plus simple à utiliser que ma solution d'origine. Par contre je suis face à un petit pb d'affichage incompréhensible à mon niveau.
Je fais appelle à une routine de mise à jour de données où j'ai installé ton programme pour mettre un message d'attente. Cet appel peut être fait quelque soit la feuille active de mon classeur. Cela se passe très bien depuis les différentes feuille sauf depuis une feuille spécifique où je n'ai pas l'extension de la shape, même si je met la valeur d'affichage identique.
Aurais-tu une idée de l'origine de cela?
Par avance merci de ton éclairage.
Bonsoir Dudu2,
J'ai épuré mon programme pour ne laisser que 3 feuilles avec dans chaque, un bouton pour tester les différents affichages. tu constateras que pour la feuille "KPI Fédération" l'affichage ne s'est pas adapté (et jusqu'à maintenant, c'est la seule feuille qui a ce défaut...). Il est vrai que j'ai rajouté des variables pour modifier le contour, mais je m'explique pas ce pb.
Merci par avance du temps passé sur ce pb.
Bonsoir @Dudu2
en fait si ca marche pas a tout les coup c'est pas l'autosize qui déconne
ça dépend de la longueur de texte comme tu le dimensionne pas ou seulement a 11
et certaine propriété pour les shape.fill ont un rendu différent selon les version des fois
c'est pour cela que j'accède aux propriété par le drawingobjects
de plus tu supprime pas les marges donc tu a un effet wraptext parfois et le autosize qui te donne l'impression de ne pas avoir fonctionné
je fait donc sauter les marges et le wrap text
juste un exemple comme ca vite fait j'ai pas fait tout les arguments mais somme toute mon texte n'est pas coupé que ce soit avec des gros font size ou pas
VB:
Sub test1()
ExempleShape2 "exemple1", msoShapeGear6, 40
ExempleShape2 "exemple2", 3, 11
ExempleShape2 "exemple3", 2, 20
ExempleShape2 "exemple4", msoShapeCloudCallout, 25
End Sub
Sub ExempleShape2(nom, forme, fsize)
Dim sh As Shape
Set sh = ActiveSheet.Shapes.AddShape(forme, 80, 50, 110, 110)
sh.Name = nom
With ActiveSheet.DrawingObjects(nom)
'propriété accessible en tant que drawingobject
.Text = "BONJOUR DUDU2" ' 'comme les cellules
.Font.Color = vbRed 'comme les cellules
.Font.Size = fsize 'comme les cellules
.Font.Bold = False 'comme les cellules
.Font.Italic = True 'comme les cellules
.HorizontalAlignment = xlHAlignCenter 'comme les cellules
.VerticalAlignment = xlVAlignCenter 'comme les cellules
.Interior.Color = vbYellow 'comme les cellules
.Border.Color = vbRed
'propriété accessibles par l'object de type shape
'<<.ShapeRange>> pour convertir drawingobject en shape
With .ShapeRange
.TextFrame2.WordWrap = False 'on bloque le retour à la ligne bien evidement avant le autosize
.TextFrame.AutoSize = True
'les bordures
.Line.Weight = 1 'epaisseur bordure(0 pas de bordure)
.Line.DashStyle = msoLineDash 'bordure en pointillet( msoLineSolid pour ligne continue)
'suppression des marges autour du texte(même effet que autosize sur le texte )
'et evite le quelques points qui manque pour ne pas avoir l'effet wrap (le texte prend toute la largeur )
.TextFrame2.MarginBottom = 0 'Marge en bas
.TextFrame2.MarginTop = 0 'marge en haut
.TextFrame2.MarginRight = 0 'marge àdroite
.TextFrame2.MarginLeft = 0 'marge agauche
End With
End With
End Sub
Merci Dudu2,
Je vais analyser la solution de Patrick mais j'ai constaté aussi que le fait de sortir de l'autozise de la boucle with (sur mon fichier en tout cas) résout le pb.
Merci beaucoup et je regarde ta V4!
Bonsoir @Dudu2
en fait si ca marche pas a tout les coup c'est pas l'autosize qui déconne
ça dépend de la longueur de texte comme tu le dimensionne pas ou seulement a 11
et certaine propriété pour les shape.fill ont un rendu différent selon les version des fois
c'est pour cela que j'accède aux propriété par le drawingobjects
de plus tu supprime pas les marges donc tu a un effet wraptext parfois et le autosize qui te donne l'impression de ne pas avoir fonctionné
je fait donc sauter les marges et le wrap text
juste un exemple comme ca vite fait j'ai pas fait tout les arguments mais somme toute mon texte n'est pas coupé que ce soit avec des gros font size ou pas
VB:
Sub test1()
ExempleShape2 "exemple1", msoShapeGear6, 40
ExempleShape2 "exemple2", 3, 11
ExempleShape2 "exemple3", 2, 20
ExempleShape2 "exemple4", msoShapeCloudCallout, 25
End Sub
Sub ExempleShape2(nom, forme, fsize)
Dim sh As Shape
Set sh = ActiveSheet.Shapes.AddShape(forme, 80, 50, 110, 110)
sh.Name = nom
With ActiveSheet.DrawingObjects(nom)
'propriété accessible en tant que drawingobject
.Text = "BONJOUR DUDU2" ' 'comme les cellules
.Font.Color = vbRed 'comme les cellules
.Font.Size = fsize 'comme les cellules
.Font.Bold = False 'comme les cellules
.Font.Italic = True 'comme les cellules
.HorizontalAlignment = xlHAlignCenter 'comme les cellules
.VerticalAlignment = xlVAlignCenter 'comme les cellules
.Interior.Color = vbYellow 'comme les cellules
.Border.Color = vbRed
'propriété accessibles par l'object de type shape
'<<.ShapeRange>> pour convertir drawingobject en shape
With .ShapeRange
.TextFrame2.WordWrap = False 'on bloque le retour à la ligne bien evidement avant le autosize
.TextFrame.AutoSize = True
'les bordures
.Line.Weight = 1 'epaisseur bordure(0 pas de bordure)
.Line.DashStyle = msoLineDash 'bordure en pointillet( msoLineSolid pour ligne continue)
'suppression des marges autour du texte(même effet que autosize sur le texte )
'et evite le quelques points qui manque pour ne pas avoir l'effet wrap (le texte prend toute la largeur )
.TextFrame2.MarginBottom = 0 'Marge en bas
.TextFrame2.MarginTop = 0 'marge en haut
.TextFrame2.MarginRight = 0 'marge àdroite
.TextFrame2.MarginLeft = 0 'marge agauche
End With
End With
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD