Pythagore cellules VBA

  • Initiateur de la discussion Initiateur de la discussion Edd93
  • Date de début Date de début

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 !

Edd93

XLDnaute Occasionnel
Bonjour,

Je vous mets en PJ mon fichier, je cherche à traduire sous VBA comme quoi une cellule doit être = à X mètre, par exemple, 1 mètre

et je cherche à calculer tous les hypothénus en même temps (flèches puisque ce sont des triangles rectangles) de la zone sélectionnée, mais pour ça j'ai besoins d'un code qui compte les cellules en opposé et en adjacent puis qui traduit ces cellules en mètre puis ensuite faire la somme horizontale et verticale en mettant à la suite au carré les deux pour en faire la somme qui correspond à l'hypothénus. Et au final je dois avoir quelque chose qui fait la somme de tous les hypothénus de la zone sélectionnée pour calculer le flux total en mètre parcouru


J'espère que vous comprendrez mon problème avec le fichier que je vous mets à disposition.
 

Pièces jointes

Re

A tester:

remplacer:
debx = cel.Left + cel.Width / 2
deby = cel.Top
finx = porteext1.Left + porteext1.Width / 2
finy = porteext1.Top + porteext1.Height

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, debx, deby, finx, finy).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen

par
debx = cel.Left + cel.Width / 2
deby = cel.Top + cel.Height / 2
finx = porteext1.Left + porteext1.Width / 2
finy = porteext1.Top + porteext1.Height / 2
lg = Sqr(((finx - debx) / cel.Width) * ((finx - debx) / cel.Width) + ((finy - deby) / cel.Height) * ((finy - deby) / cel.Height))
lgtot = lgtot + lg

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, debx, deby, finx, finy).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen

et en fin de sub

msgbox(lgtot)

NB😛our simplifier les flèches partent et arrivent aux centres des cellules
 
Rebonjour Monsieur pierrejean, je vous remercie beaucoup vous êtes très doué, ça marche, comment avez-vous fait pour dire que une cellule correspond à 1 mètre ? quelle est dans ce que vous avez écrit l'unité de la cellule ? la largeur et la hauteur vaut-elle 1 ? je vous remercie !
 
Re
1) pour le futur S T P oublie le Monsieur ,cela m'est vraiment 'inconfortable'
2) L'unité n'est pas spécifiée : le nombre obtenu est le nombre calculé selon ta formule Racine((nb cellules horizontales )2+(nb cellules verticales)2))
3) Pour être rigoureux il faudrait que tes cellules soient carrées . Alors le résultat exact sera en mètres pour peu que tu ais respecté l’échelle (cotés de cellule =1 mètre)
 
Bonjour pierrejean ! Donc on a la possibilité de changer l'échelle de la cellule sachant que initialement c'est 1x1 ? sachant que une palette fait 1.20m*1 dans mon cas, si il est possible de changer l'échelle ça serait fantastique
 
Re

Effectivement la solution est dans la modification de la formule :multiplier les Width par 1,2 si la palette est horizontale ,multiplier les Height dans le cas contraire
Edit
Euh j'ai peut-etre un peu vite,je regarde !!!!
Teste ceci:
lg = Sqr(((finx - debx) / cel.Width) * 1.2 * ((finx - debx) / cel.Width) * 1.2 + ((finy - deby) / cel.Height) * ((finy - deby) / cel.Height))
 
Dernière édition:
merci beaucou pierre jean.

J'ai un petit problème, y a quelques flèches qui doivent passer par un point avant d'aller à fin

en gros deb - intermediaire - fin au lieu de deb - fin directement. Que faire dansce cas là sachant que on a ici :

debx = cel.Left + cel.Width / 2
deby = cel.Top + cel.Height / 2
finx = porteext2.Left + porteext2.Width / 2
finy = porteext2.Top + porteext2.Height / 2

debx = porteext2.Left + porteext2.Width / 2
deby = porteext2.Top + porteext2.Height / 2
finx = porte72.Left + porte72.Width / 2
finy = porte72.Top + porte72.Height / 2


lg = Sqr(((finx - debx) / (0.8 * cel.Width)) * ((finx - debx) / (0.8 * cel.Width)) + ((finy - deby) / cel.Height) * ((finy - deby) / cel.Height))
lgtot = lgtot + lg


Je te remercie !
 
- 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

Discussions similaires

V
Réponses
2
Affichages
2 K
vynmarius
V
F
Réponses
4
Affichages
3 K
F
J
Réponses
10
Affichages
2 K
Jeralpha
J
A
Réponses
1
Affichages
3 K
K
Réponses
0
Affichages
996
korben8
K
D
Réponses
3
Affichages
5 K
R
Réponses
3
Affichages
13 K
Roverman
R
P
Réponses
2
Affichages
12 K
pyroteknix
P
Retour