XL 2010 dessiner avec VBA sous excel 2010

[artlight]

bonjour à tous
je suis passionné de moteurs 2 temps depuis ma tendre enfance
avec mon frangin on voudrait compiler une base de données de pas mal de moteurs qu'on a accumulé au cours des ans.
ce qui nous intéresse est de dessiner l’intérieur d'un cylindre du moteur 2 temps
c'est un fut dans lequel coulisse un piston qui ouvre et ferme des "lumières"
admission 'A) , échappement (E et B) , transferts (T1 > T4): que des rectangles (pour rester simple)

on fait un relevé de cotes interne puis on le transcris sur un dessin qui est un "développé" du cylindre (comme si le cylindre était déroulé à plat)

je me suis fait un petit fichier dans lequel on entre les relevés, puis une macro qui va dessiner les rectangles sur un onglet "dessin"
la macro va lire les données qui sont résultats de calculs des relevés (tableau W6 - Z19)
le développé d'un cylindre étant toujours un dessin symétrique par rapport à l'axe central (qui passe par le centre de "E"), on ne renseigne que les valeurs des lumieres à gauche de E , chaque rectangle de gauche a son jumeau à droite de E.

jusqu'ici tout va bien
je vous préviens, je suis un quiche en VBA, sans doute mon code est tout pourri... ou trop enfantin. j'ai fait avec ce que j'ai glané ci et la.
rien de transcendant
mais ça fonctionne, alors ... c'est déjà des heures de gagné plutôt que de le faire à la main avec une réglet sur une feuille volante !


je cherche à faire d'autres choses avec ce même bidule :
les rectangles doivent être d'une certaine couleur (contour et épaisseur du contour) et "transparent" en remplissage
comme sur mon onglet ; rouge pour "E" et "B" / bleu pour tous les "T" / vert pour les "A" / noir pour le développé total
2 lignes "PMH" et "PMB" (j'ai fait des rectangle sans épaisseur... je ne sais pas faire de ligne ! ) , je les voudrais en pointillés, d'une certaine épaisseur également : idem, comme sur mon onglet données. et pourquoi pars aussi d'une autre couleur

je voudrais aussi pouvoir jouer sur l’échelle globale du dessin tracé car il est tout petit !
je saurais le faire :
- sur le tableau dans l'onglet de données. mais tout est en mm (valeurs réelles), c'est dommage de changer
- j'ai vu qu'on pouvait ajouter un multiplicateur (*1 / *2 etc...) à chaque "mesure" des coordonnées du rectangle sous VBA. avec plus de 15 rectangles, c'est un peu fastidieux. le plus simple serait de se servir d'une case dans l'onglet données que VBA aille lire pour faire une échelle globale. (c'est moi qui ecrit 1, ou 2, ou 5 ou 10 .. dans cette case "echelle", suivant la taille que je veux). ça peut se faire en "global" ou faut le faire forme par forme ?


et enfin, je voudrais savoir la possibilité -ou non- d’écrire des infos sur le dessin tracé. (info qui seront à lire dans l'onglet "données" : pas encore présente)
infos qu'il faudrait écrire dans les rectangles tracés : donc un texte à positionner en fonction de la taille des formes : jamais au même endroit de la feuille, mais toujorus au même endroit de la forme

merci de votre aide précieuse
Joël

 

[sylvanu]

Bonjour,
Quel code utilisez vous pour les TextBox ?
Pourquoi ne pas utiliser un rectangle blanc .

pour ce qui est du texte, c'est simple. Si la valeur affichée est Angle, alors :

Angle = 48.1234

.DrawingObject.Text = Round(Angle, 1) & "°"

 

[artlight]

For i = 34 To 42 ' MESURES ALTIMETRIE
Contour = Sheets("données").Cells(i, 33)
Epaisseur = Sheets("données").Cells(i, 34)
ColorLine = Sheets("données").Cells(i, 35).Interior.Color
With Feuil3.Shapes.AddShape(msoShapeRectangle, _
Echelle * Cells(i, 27), Echelle * Cells(i, 28), Echelle * Cells(i, 29), Echelle * Cells(i, 30)).TextFrame.Characters
.Text = Cells(i, 36)
With .Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 12
.ColorIndex = Cells(i, 35)


End With
End With

Next i

 

[artlight]

pareil avec les rectangles

le texte s'affiche bien, mais je ne peux pas mettre de code qui intervienne sur le cadre ET sur le texte dans le meme "groupe".
j'ai essayé plein de solutions, c'est soit l'un soit l'autre
je n'arrive pas a mettre les deux codes a la suite, la macro plante.


je suis un vrai quiche comme dit plus haut, je tâtonne et tente un tas de trucs sans bien comprendre les bases même de VBA

 

[artlight]

merci pour le code des angles, c'est exactement ça !

 

[sylvanu]

Ce n'est pas une TextBox c'est un rectangle.
Texte en °, police noire sur fond blanc :

Sub MettreDegresDansShape()
    ' Valeur de l'angle à afficher pour le test
    Angle = 359.87654
    ' Taille shape pour afficher 359.9° en arial 16
    With Feuil1.Shapes.AddShape(msoShapeRectangle, 20, 20, 70, 20)
        .Name = "Titre"                                 ' Donner un nom au shape
        .Fill.BackColor.RGB = RGB(255, 255, 255)        ' Couleur du fond blanc
        .Line.ForeColor.RGB = RGB(255, 255, 255)        ' Couleur des traits blancs
        .DrawingObject.Text = Round(Angle, 1) & "°"     ' Degrés avec 1 chiffre décimal + °
    End With
    ActiveSheet.Shapes("Titre").Select
    With Selection.Font
        .Size = 16                                      ' Taille police 16
        .Name = "Arial"                                 ' Type police Arial
        .FontStyle = "Normal"                           ' Type Normal
        .Color = 0                                      ' Couleur noire
        Selection.VerticalAlignment = xlCenter          ' Centrer verticalement
        Selection.HorizontalAlignment = xlCenter        ' Centré horizontalement
    End With
End Sub

 

[artlight]

ben j'y arrive pas..
j'ai copié collé exactement ce que tu m'as mis plus haut (en adaptant avec mes infos et tout le reste du code bien sur)
c'est comme avant
a partir du moment ou le mot "select" est dans le code.
çà plante
> donc j'arrive a faire sans ce "select" , mais soit je peux influer sur le font, soit sur la forme
jamais les deux en même temps

je suis une quiche et j'y comprends rien
dégouté je suis quasi au bout : ça rend FOU.
mais j'y arriverai nom de diou !!!!

For i = 21 To 33 ' MESURES ANGLES
With Feuil3.Shapes.AddShape(msoShapeRectangle, _
Echelle * Cells(i, 27), Echelle * Cells(i, 28), Echelle * Cells(i, 29), Echelle * Cells(i, 30))
.Name = "Titre" ' Donner un nom au shape
.Fill.BackColor.RGB = RGB(255, 255, 255) ' Couleur du fond blanc
.Line.ForeColor.RGB = RGB(255, 255, 255) ' Couleur des traits blancs
.DrawingObject.Text = Round(Cells(i, 36), 1) & "°" ' Degrés avec 1 chiffre décimal + °
End With

ActiveSheet.Shapes("Titre").Select
With Selection.Font
.Size = 8 ' Taille police 16
.Name = "Arial" ' Type police Arial
.FontStyle = "Normal" ' Type Normal
.Color = 0 ' Couleur noire
Selection.VerticalAlignment = xlCenter ' Centrer verticalement
Selection.HorizontalAlignment = xlCenter ' Centré horizontalement
End With

 

[sylvanu]

Mon exemple est pour un shape pour simplifier.
Tous vos shapes s'appellent Titre donc il doit se mélanger les pinceaux.
Remplacer .Name="Titre" par .Name="Texte" & i
De cette façon ils s’appelleront Texte21 à Texte33.
( Texte c'est mieux que Titre dans votre application )
Je pense que ça va résoudre le problème.

 

[artlight]

ok merci, je regarde !

 

[artlight]

et du coup je mets quoi ici à la place de "titre" ?
ActiveSheet.Shapes("Titre").Select

 

[artlight]

j'ai réussi !!!!!!!!!!!!!!!!!!!!

tout ce que je voulais
TOUT fonctionne

j'ai un peu fait autrement que ton exemple au dessus, car je n'y arrivais pas.

BON
je dois faire un gros ménage maintenant de tout les trucs inutiles qui trainent partout
finir qqs bidouilles encore
mais c'est FAIT !

j'y crois pas, je suis trop content.
merci 1000 fois de ton aide, vraiment.