Mise en forme AddTextBox
Ceci est mon premier post sur ce forum , donc Bonjour a tous !!!
Je m'excuse d'avance si le vocabulaire que j'utilise n'est pas exact.
J'ai réalisé une feuille de calcul qui me permet d'obtenir la force résultante consécutive a l'application d'un multitude de force sur un même point (boring :)).
J'y ai ajouté une petite visualisation des forces en dessinant des vecteurs.
Mon code marche et me convient , mais je n'arrive pas a trouvé les commandes utiles pour mettre en forme un TextBox :
- Enlevé le cadre autour du texte
- Rendre le fond transparent
Voici mon code, au passage si vous avez des remarques ou conseils sur ce code je suis très preneur , c'est la 1ere fois (et surement pas la dernière car j'aime beaucoup ca), que je met les mains réellement dans VBA.
Pour précision les différentes caractéristique de mes forces sont de la lignes 2 a 11 et celles de ma Force résultante sont sur la ligne 12 (d'où le double If car la flèche n'est pas de la même couleur)
Merci a tous d'avance pour votre aide et vos précieux conseils !
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
Dim Start_x As Integer, Start_y As Integer, End_x As Integer, End_y As Integer, NLigne As Integer
Start_x = Cells(2, 10)
Start_y = Cells(2, 11)
NLigne = 2
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
Do While NLigne <= 12
End_x = Cells(NLigne, 8) + Start_x
End_y = Cells(NLigne, 9) + Start_y
If NLigne <> 12 Then
If Cells(NLigne, 8) <> 0 And Cells(NLigne, 9) <> 0 Then
With Feuil1.Shapes.AddLine(Start_x, Start_y, End_x, End_y).Line
.Weight = 3
.EndArrowheadStyle = msoArrowheadTriangle
End With
With Feuil1.Shapes.AddTextbox(msoTextOrientationHorizontal, End_x, (End_y - 20), 40, 20).TextFrame
.Characters.Text = Cells(NLigne, 1)
End With
End If
Else
With Feuil1.Shapes.AddLine(Start_x, Start_y, (Cells(12, 8) + Start_x), (Cells(12, 9) + Start_y)).Line
.Weight = 3
.EndArrowheadStyle = msoArrowheadTriangle
.ForeColor.RGB = RGB(255, 0, 0)
End With
With Feuil1.Shapes.AddTextbox(msoTextOrientationHorizontal, End_x, (End_y - 20), 40, 20).TextFrame
.Characters.Text = Cells(NLigne, 1)
End With
End If
NLigne = NLigne + 1
Loop
End Sub
Bonjour Pe.Brouard et bienvenu, bonjour le forum,
Si ta textbox est issue de la boîte à outils Controles ActiveX, en mode [Création] double-clique dans la textbox ou clic droit et menu Visualiser le code, ça ouvre VBE (l'éditeur Visual Basic) et dans le cadre en bas à gauche tu as la fenêtre des propriétés qui te permet de formater ta textbox.
Sinon, pour le code, sans fichier, perso je ne le regarde pas...
Excuse moi c'est vrai que sans le fichier c'est n'est pas parlant ....
Le voici :
Merci !!
Re,
Ton code est nickel !
Je te propose une variante mais rien ne dis quelle soit mieux que ta proposition, c'est juste que je n'aime pas les boucle Do... Loop :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
Dim Start_x As Integer, Start_y As Integer, End_x As Integer, End_y As Integer, I As Integer
Start_x = Cells(2, 10)
Start_y = Cells(2, 11)
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
For I = 2 To 12
End_x = Cells(I, 8) + Start_x
End_y = Cells(I, 9) + Start_y
Select Case I
Case Is < 12
If Cells(I, 8) <> 0 And Cells(I, 9) <> 0 Then
With Feuil1.Shapes.AddLine(Start_x, Start_y, End_x, End_y).Line
.Weight = 3
.EndArrowheadStyle = msoArrowheadTriangle
End With
With Feuil1.Shapes.AddTextbox(msoTextOrientationHorizontal, End_x, (End_y - 20), 40, 20).TextFrame
.Characters.Text = Cells(I, 1)
End With
End If
Case Else
With Feuil1.Shapes.AddLine(Start_x, Start_y, (Cells(12, 8) + Start_x), (Cells(12, 9) + Start_y)).Line
.Weight = 3
.EndArrowheadStyle = msoArrowheadTriangle
.ForeColor.RGB = RGB(255, 0, 0)
End With
With Feuil1.Shapes.AddTextbox(msoTextOrientationHorizontal, End_x, (End_y - 20), 40, 20).TextFrame
.Characters.Text = Cells(I, 1)
End With
End Select
Next I
End Sub
Merci , beaucoup !!
Avec ton astuce a partir des controles activeX j'ai pu trouver les commandes nécessaires ca fonctionne.
Et pour le codes , ton codes marches aussi mais j'ai tellement gamberger sur le mien que je vais essayer de le garder pour l'instant car j'ai plus de facilité pour le relire !! Pk n'aimes tu pas les boucle do ?
Encore merci !
Re,
Pk n'aimes tu pas les boucle do
Encore une de mes manies ridicules... Mais comme toi, j'ai plus de facilités à me relire.