Dimension/positionnement forme suite a résultat calcul

Bonjour,

Il y a des années, eriiic m'a sorti une "fonction". Je ne connaissais même pas cette possibilité, elle m'a été énormément utile, et je l'utilise tjr dans mon mini logiciel. Grand merci à cette âme charitable....

Aujourd’hui je reviens vous voir pour un truc bien tordu...

Je créé un mini logiciel pour être capable de comptabiliser le nombre de panneau photovoltaïque possible de poser sur une toiture. La toiture peut avoir une surface de type rectangle, trapèze ou mixte des deux sur la droite ou la gauche. Jusque la je gère, le + - * et / me pose pas trop de probleme.

Je souhaite maintenant pouvoir réaliser un dessin du résultat, que le client puisse visualiser la forme du toit et le positionnement des panneaux dessus. Bien entendu l'idée est que le dessin se forme et se positionne seul en fonction des résultats. Le dessin doit avoir 1 rectangle ou trapèze représentant la toiture, puis X rectangle représentant les panneaux photovoltaïque. Les panneaux pourront être en mode portrait ou paysage.

Les infos dont je dispose:

- hauteur largeur toiture sur rectangle

- Hauteur largeur partie rectangulaire de la toiture trapèze + largeur triangle à droite ou a gauche ou les deux

- Hauteur largeur panneau + marge haute bas et coté toiture + espace vertical et horizontal entre panneau.

- Je sais combien de panneau j'ai sur la ligne en bas de toiture et combien sur seconde rangée supérieur

- Je peux savoir si les panneaux ligne du haut sont aligné verticalement à ceux du bas ou en décalé à 50% (décalé comme sur dessin)

- Le centre en largeur de l'ensemble des panneaux doit être centré sur la largeur toiture.

Ci dessous l'idée d'un résultat....

Pour corser le tout on peu supposer que je tombe sur une cheminé, velux ou autre qui empêcherait la pose d'un ou plusieurs panneau... s'il est possible de gérer ça, on est au top!

Bon, j'ai l'impression de demander la lune... S il y a quelques cosmonautes balaises en excel en vacances sur terre... Merci

AlainB

Je suis en train de creuser... J'ai trouvé ça:

Sub FormeRectangle()
Dim Sh As Shape
ThisWorkbook.Worksheets("Prise d'information").Activate
Set Sh = ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, 100, 100, 50, 80)
Sh.Fill.ForeColor.RGB = RGB(255, 0, 255)
Sh.Line.ForeColor.RGB = RGB(0, 255, 0)
Sh.Line.Weight = 3
Sh.Rotation = 20
End Sub

Ça me permet de commander la création d'un rectangle de travers de couleur rose et bordure verte. Je devrais pouvoir le redresser, modifier la position, et changer la couleur.

Je vais partir la dessus pour la quantité de panneau et leur positionnement.

Il me restera a savoir comment créer le trapèze.

Pour prendre les choses par le début, quelqu'un saurait il modifier le code pour que dans la feuille "donnée_position" dans la cellule

B2 et B3 j'ai les valeurs de positionnement du rectangle

B4 et B5 j'ai les valeurs de dimension du panneau

Merci

Bonjour,

si j'ai compris:

...
With Worksheets("donnée_position")
Set Sh = ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, .Range("B2"), .Range("B3"), .Range("B4"), .Range("B5"))
End With
...

A+

Salut AlgoPlus

Merci pour les infos

J'ai trouvé ça pour le trapèze pour la forme de mon toit.

Sub trapeze()
Dim Sh As Shape
ThisWorkbook.Worksheets("Prise d'information").Activate
Set Sh = ActiveSheet.Shapes.AddShape _
(msoShapeTrapezoid, 100, 19, 80, 80)
Sh.Fill.ForeColor.RGB = RGB(102, 102, 102)
Sh.Line.ForeColor.RGB = RGB(0, 0, 0)
Sh.Line.Weight = 2
Sh.Rotation = 0
End Sub

Es ce que quelqu'un saurait me dire si l'on peut modifier les cotes bleu et verte indépendamment? Dans le code que j'ai je ne peut apparemment pas. Faut il que je passe par autre chose qu’un trapèze? un quadrilatère ou autre?

Merci

Bon, je suis toujours coincé pour créer un trapèze ou je peux modifier indépendamment les 4 angles.

La toiture n'a jamais la même largeur au dessus, ni en dessous, du coup les angles non plus. Il me faut pouvoir saisir 2 valeurs (abscisse et ordonnée) pour chacun des 4 points de la forme.

Sur la forme rectangle on peut donner 4 valeurs, ce sont position et dimension. Mais pas travailler sur chacun des 4 angles individuellement...

Je tente de voir avec forme libre si je peux....

Si quelqu'un a une idée

Merci

Je poursuis.....

J'ai trouvé, je crois forme simple ou libre qui me permet de faire un quadrilatère:

Sub création_toiture()
'
' création toiture

'Dim triArray(1 To 5, 1 To 2) As Single
triArray(1, 1) = 100 'haut gauche H
triArray(1, 2) = 100 'haut gauche V
triArray(2, 1) = 20 'bas gauche H
triArray(2, 2) = 300 'bas gauche V
triArray(3, 1) = 300 'bas droit
triArray(3, 2) = 300
triArray(4, 1) = 200 'haut droit
triArray(4, 2) = 100
triArray(5, 1) = 100 ' Last point has same coordinates as first
triArray(5, 2) = 100
Set myDocument = Worksheets(5)
myDocument.Shapes.AddPolyline triArray
End Sub

Hier Algoplus m' a donné une info pour pouvoir sélectionner dans une cellule les valeurs que je souhaite utiliser pour modifier les coordonnées des 4 points d'un rectangle. Du coup je suis en train de tenter d’intégrer son bout de code.

...
With Worksheets("donnée_position")
Set Sh = ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, .Range("B2"), .Range("B3"), .Range("B4"), .Range("B5"))
End With
...

Tout me prend une heure... chaque avancé prend un temps de fou, puisqu'il me fat tester modifier chaque réaction de chaque modification et tenter de comprendre ce qu'il se passe en fonction de ce que j'ai fait puis d'adapter....

Ok j'ai le code pour aller chercher valeur dans une cellule, exemple:

triArray(5, 1) = Range("B2")

Maintenant je veux qu'il aille prendre la valeur dans une autre feuille que celle ou je dessine...

triArray(1, 1) = Sheets("Calcul_visuel").Range("b5")

Ça il aime pas du tout du tout du tout.... ... Je creuse...

Bon bein bien creuser ça marche....

Je me rend compte qu'a chercher on trouve avec un peu de logique en reprenant/modifiant les codes d'autres... Mais je serais incapable d'écrire la moindre ligne autrement....

Me reste à programmer les points de mon toit en fonction des cotes relevées sur site, puis de positionner mes panneaux sur toiture... Ca ca va se passer sur feuille de calcul....

Bonjour,

J'ai un ptit soucis qui peut m'aider?

Sub création_toiture()
'
' création toiture
'
Dim triArray(1 To 5, 1 To 2) As Single
triArray(1, 1) = Sheets("Calcul_visuel").Range("b5") 'haut gauche H
triArray(1, 2) = Sheets("Calcul_visuel").Range("b6") 'haut gauche V
triArray(2, 1) = Sheets("Calcul_visuel").Range("b7") 'bas gauche H
triArray(2, 2) = Sheets("Calcul_visuel").Range("b8") 'bas gauche V
triArray(3, 1) = Sheets("Calcul_visuel").Range("b9") 'bas droit
triArray(3, 2) = Sheets("Calcul_visuel").Range("b10")
triArray(4, 1) = Sheets("Calcul_visuel").Range("b11") 'haut droit
triArray(4, 2) = Sheets("Calcul_visuel").Range("b12")
triArray(5, 1) = Sheets("Calcul_visuel").Range("b5") ' Last point has same coordinates as first
triArray(5, 2) = Sheets("Calcul_visuel").Range("b6")
Set myDocument = Worksheets(5)
myDocument.Shapes.AddPolyline triArray
Sheets("visuel").Shapes(1).Name = "toiture"
ActiveSheet.Shapes("toiture").Fill.ForeColor.RGB = RGB(250, 86, 40)
End Sub

La ligne en gras ne fonctionne pas... J'ai tenté de rajouter ca pour changer la couleur. Ce que je ne comprends pas c'est d'ou vient la couleur Bleu d'office.

Second truc je souhaiterais nommer ma forme pour pouvoir sur seconde macro utiliser un bouton pour éffacer la forme.

Merci

Re,

Essayer de mettre en forme votre code, c'est plus lisible et compréhensible....

Pour pouvoir "manipuler la forme créée:

....
Set myDocument = Worksheets("visuel") ' a priori c'est la feuille N° 5
Set myShape = myDocument.Shapes.AddPolyline(triArray)  
With myShape
 .Name = "Toiture"
 .Fill.ForeColor.RGB = RGB(250, 86, 40)
End With
....

la couleur Bleu d'office (couleur par défaut de la forme ??) vient sans doute d'une option mais je ne me suis pas casser la tête dessus.

A+

Merci algoplus.

Je pars en vacances, je reviens dimanche prochain je me remet dessus dès que je rentre.
bonne semaine à tous

Bonjour les fans d'excel...

Retour de vacances, je reprends le travail sur ma mini appli...

J'aurais besoin de savoir s'il est possible de faire un truc. J'ai une "case à cocher, controle activX" qui créé le dessin d'un panneau solaire, représenté par un rectangle. Lorsque je coche cette case à cocher cela lance une macro qui dessine un panneau nommé genre "panneau 11" ou "panneau 22".

J'ai environ 30 panneau différents, de 1 à 30. J'aurai autant de "case à cocher", une par panneau.

J'ai réussi a créer le lien entre mes cases à cocher et la macro qui créé (dessine) le panneau. Ce que j'aimerais c'est que lorsque je décoche la case à cocher, le panneau disparaisse.

Merci

Bonjour,

Un essai :

on cherche si le shape existe déjà.

Si oui le shape est visible si la case à cocher est cochée et invisible sinon

Si non le shape est créé :

Private Sub CheckBox1_Click()
Dim Trouv As Boolean

For Each Sh In ActiveSheet.Shapes ' chercher si le shape existe déjà
 If Sh.Name = "Rectangle 1" Then Trouv = True: Exit For
Next
If Trouv Then 'si le shape existe
    Shapes("Rectangle 1").Visible = CheckBox1.Value 'le shape s'affiche quand la case est cochée
Else
    'code creation du shape
End If
End Sub

Il faudra autant de sub que de case à cocher; ou bien, passer par un module de classe pour n'avoir qu'un code pour l'ensemble des cases à cocher

Bonne reprise