Comment savoir si un shape ligne passe au dessus d'une cellule non vide
Bonsoir à tous !
VBA et Shapes à l'horizon !
Je cherche un moyen de connaitre si une "ligne droite" peut atteindre un shape sans passer sur une cellule dont la valeur est non nulle.
Dans le fichier joint c'est une situation qui peut arriver à l'Enchanteur, il peut lancer un sort (ligne droite) vers 4 cibles (squelettes), mais voilà, à cause des murs seules deux cibles peuvent être touchées. Les deux autres, l'équivalent du sort passe au dessus d'au moins une cellule non nulle, ici valeur 0 qui symbolise des murs.
Cette valeur peut être un X symbolisant par exemple un mobilier, ou tout autre valeur symbolisant soit les autres aventuriers soit un créature indifférente au sort (mais ça c'est une autre histoire...)
On m'a donné un code de déplacement, mais ce dernier n'était pas "gêné" par la transpercée des murs...
Le fichier représentatif :
La représentation :
La cerise sur le gâteau serait de connaitre la "distance" entre la cible possible et le héro comme cela si 2 cases sort puissant = plus de dégâts et si loin alors sort moins puissant... Les noms des shapes actuellement sur le fichier : Hero, Squelette 1 à 4, sur l'image le squelette 1 à gauche ligne verte serait "moins" touché que le squelette 4 ligne verte à droite, les squelettes 2 et 3 ne sont pas ciblés car le sort passe sur des cellules non vides.
@ bientôt
LouReeD
J'ai fait ce code, mais la plage calculée est trop grande du coup sur cette nouvelle configuration les deux squelettes de gauche sont possibles mais celui en B8 est calculé non possible du fait que la plage et le tests de valeur se fasse sur des cellules "non concernées"...
Le code vite fait :
Sub LRD()
Dim Sh As Shape, plage As Range, Tablo(1 To 4)
Tablo(1) = "B12": Tablo(2) = "B8": Tablo(3) = "H4": Tablo(4) = "P8"
For i = 1 To 4
Set Sh = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Range("N12").Left + Range("N12").Width / 2, Range("N12").Top + Range("N12").Height / 2, _
Range(Tablo(i)).Left + Range(Tablo(i)).Width / 2, Range(Tablo(i)).Top + Range(Tablo(i)).Height / 2)
Set plage = Range(Sh.TopLeftCell.Address & ":" & Sh.BottomRightCell.Address)
resultat = Application.WorksheetFunction.CountA(plage)
If resultat > 0 Then MsgBox plage.Address & " pas possible" Else MsgBox plage.Address & " possible"
Sh.Delete
Next i
End SubForcément sur la plage rose il y a des valeurs de mur donc resultat > 0 mais ces murs n'empêchent pas le sort !
J'y retourne...
@ bientôt
LouReeD
J'ai écris un code qui gère le côté "connecteur" des lignes si cela peut être utile....
Sub LRD()
Dim Sh As Shape, plage As Range, Tablo(1 To 4), ShH As Shape, ShM As Shape
Set ShH = ActiveSheet.Shapes("Hero")
Tablo(1) = "B12": Tablo(2) = "B8": Tablo(3) = "H4": Tablo(4) = "P8"
For i = 1 To 4
Set ShM = ActiveSheet.Shapes("Squelette" & i)
' Set Sh = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Range("N12").Left + Range("N12").Width / 2, Range("N12").Top + Range("N12").Height / 2, _
' Range(Tablo(i)).Left + Range(Tablo(i)).Width / 2, Range(Tablo(i)).Top + Range(Tablo(i)).Height / 2)
' Set plage = Range(Sh.TopLeftCell.Address & ":" & Sh.BottomRightCell.Address)
' resultat = Application.WorksheetFunction.CountA(plage)
Set c = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 0, 0, 0, 0)
With c.ConnectorFormat
.BeginConnect ShH, 1
.EndConnect ShM, 1
c.RerouteConnections
.BeginDisconnect
.EndDisconnect
End With
Next i
End SubDu coup les lignes vont non plus au centre de la cellule où se trouve le shape mais sur l'un des ses 4 connecteurs, c'est pas mal, mais cela ne résout pas le problème de connaitre la valeur des cellules survolées par ce connecteur...
@ bientôt
LouReeD
bonsoir LouReeD,
j'avais commencé, mais je vois que je n'ai pas bien compris la question, donc si ceci ne te sert pas, désolé ....
Bonsoir BsAlv,
je vous rassure, vous avez très bien compris la demande.
Si je comprend le boolean du mur c'est vrai quand il y a impact donc le sort n'est pas possible.
De mon côté je ne peux en dire autant pour la compréhension de la démarche...
si je comprend bien avec l'instruction WorksheetFunction.LinEst vous arrivez à déterminer plus ou moins le survol d'une cellule de chaque point de la ligne et donc de savoir s'il y a une valeur dans cette dernière ?
Je viens de faire un test en supprimant des murs et je vois que la précision est au rendez-vous ! Voyez ceci :
Pour le squelette2 il voit impact avec le mur alors que c'es minime !
Si je retire le mur en F9 :
Le mur n'est plus détecté !
Alors je n'ai qu'un mot à vous dire : BRAVO !
Encore un soucis de plus en moins pour mon adaptation d'HéroQuest sous Excel VBA !
Je comprends également qu'avec mes égarements de recherche de solution vous ayez pu croire ne pas comprendre la demande ! Mais non, simplement en sortant des fonctions dont je n'ai même pas connaissance vous me donnez une solution qui marche au delà de mes espérances et en plus sans trop de ligne de codes ni même d'astuce ou rustines pour le fonctionnement !
Merci @ vous
@ bientôt
LouReeD
re,
un peu mieux écrit ...
s'il y a encore une erreur, télécharge un exemple.
BsAlv, bonjour,
Je valide à 100% cette nouvelle version ! Suite aux tests tout fonctionne comme voulu.
Je me retrouve donc avec une fonction qui renvoie faux si l'on peut cibler le shape choisi, et une valeur numérique qui peut me permettre de varier la puissance du sort en fonction de la distance de cette cible !
Merci encore pour tout.
@ bientôt
LouReeD
re,
supér ! Je n'ai pas vérifié si cela fonctionne avec des lignes ou des colonnes cachées (donc avec hauteur ou largeur = 0 mais contiennent une valeur 0).
Pour le but recherché il n'y aura pas de lignes ou colonnes masquée.
@ bientôt
LouReeD
Bonjour BsAlv,
il y a un problème pour la dépose des fichiers et des images sur le site actuellement...
Je vous écris suite à la découverte d'une "anomalie" que je ne m'explique pas.
En prenant le dernier fichier que vous m'avez transmis, si vous placez le Héro en H12, et le squelette4 par exemple en J8, le code estime que le sort peut être lancé.
Si on inverse les deux shapes, l'erreur existe encore, par contre il suffit de décaler l'un des shapes sur une cellule libre à côté des ces deux cellules (par exemple le Héro en J12, ou bien le squelette en L8) alors le code indique bien qu'il y a un mur...
Par contre si on déplace les deux shapes en J12 et L8, l'erreur revient... en L12 et N8 simultanément c'est identique le sort peut être lancé !
Mais si au lieu de se déplacer vers la droite on décide de monter en H10 et J10, ça marche. Et une fin "grimpé" en J10 et L10, ça marche...
Je me demande bien de quoi cela peut venir, et pour le moment c'est la seule "combinaison" que j'ai trouvé comme cela.
Je continue mes recherches sur un tableau correspondant à la taille du plateau de jeu final.
Désolé de ne pouvoir vous envoyer le fichier dans la configuration voulue, mais j'ai fait le test avec le dernier fichier fourni.
Comme je n'ai pas non plus assimiler le code à 100% j'ai du mal à voir d'où cela peut venir.
Mais cela ne change rien à l'efficacité du code qui je trouve vraiment excellent !
@ bientôt
LouReeD
Après plusieurs pas à pas, il se trouve que dans la configuration énoncée, la boucle de test de présence de mur ne teste pas la dernière colonne, du certainement à la boucle de N2-1, mais si je retire le -1, alors il manque une valeur dans le tableau des left et top des tableaux aLeft et aTop.
Mon idée est de boucler une fois de plus pour remplir ces tableaux et ainsi pouvoir retirer le N2-1 en N2 afin de bien boucler sur l'ensemble des colonnes.
J'essaie et je reviens.
@ bientôt
LouReeD
Bon ceci arrange le fait de tester la dernière colonne, mais engendre un nouveau problème : si un mur se trouve en dessous du Héro alors que le sort va vers le haut, lors des tests de présence du mur, la cellule du dessus est prise en compte, donc un mur est compté...
Si je saisie le fonctionnement : pour une largeur de colonne, on sélectionne les cellules "verticales" où la courbe passe, une fois cette plage récupérée, on compte le nombre de 0. Donc cette nouvelle erreur vient du fait de boucler une fois de plus sur les lignes, et on sélectionne en première zone cette ligne en trop...
J'y retourne !
@ bientôt
LouReeD
Re bonjour,
voici mes modifications de votre code afin de pallier au problème énoncé :
Else
' récupération des valeurs Left des bordures de la plage dont le left qui correspond au Right de la plage
ReDim aLeft(1 To N2 + 1)
For i = 1 To N2 + 1
aLeft(i) = c0.Offset(, i - 1).Left
Next i
' récupération des valeurs Top des bordures de la plage, dont le Top qui correspond au bottom de la plage
ReDim aTop(1 To N1 + 1)
For i = 1 To N1 + 1
aTop(i) = c0.Offset(i - 1).Top
Next i
For i = 1 To N2 'boucler les colonnes
Y1 = aLinEst(1) * aLeft(i) + aLinEst(2)
r1 = Application.IfError(Application.Match(Y1, aTop, 1), 1) 'colonne qui correspond avec l'intersection du bordure haut
Y2 = aLinEst(1) * aLeft(i + 1) + aLinEst(2)
r2 = Application.IfError(Application.Match(Y2, aTop, 1), 1) 'colonne qui correspond avec l'intersection du bordure bas
Set c = c0.Cells(Application.Min(r1, r2), i).Resize(Abs(r2 - r1) + IIf(r2 <> r1 And i = 1, 0, 1)) 'plage des cellules, 1 ligne et x colonnes
c.Select ' ici j'affiche la plage en cours de test pour la présence des "0"
bMur = (WorksheetFunction.CountIf(c, 0) > 0) 'dès qu'on a 1 cellule qui contient 0, on passe un mur
If bMur Then Exit For 'inutile de continuer
Next
End IfJe test encore différentes configuration mais pour le moment cela semble bon.
Donc j'ai ajouté une "boucle" pour les valeurs en left et en top, afin de bien boucler sur le nombre de colonne existantes donc N2 au lieu de N2-1.
Mais j'ai du ajouter une double condition pour la définition des plages survolées par la ligne : le "+1" n'est valable que pour un i > 1 et un r1 <> r2, en somme si r1=r2 ET i= 1 alors +0, sinon +1
A voir avec les tests à venir, maos de votre côté cela vous semble-t-il cohérent ?
@ bientôt
LouReeD
re,
j'avais lu ton premier poste et j'ai modifié mes macros, mais je n'ai pas encore lu vos autres postes, donc peut-être que vous avez déjà résolu le problème. Je vois aussi, qu'on n'est pas encore capable à télécharger des fichiers, désolé. J'utilise une ligne du centre de héro1 vers un squelette et si cette ligne touche le bordure d'une cellule "0", donc un mur, b=mur est "VRAI". Ce touche est vraiment "précis". Donc c'est vraiment le centre de la forme qui m'intéresse, le "topleftcell" n'est pas important.
PS. voir PM
re,
j'ai lu les plaintes et j'ai créé une nouvelle version avec un peu d'explication dedans. J'éspère que ce n'est pas trop "académique"
Bonjour,
Cela me semble parfait !
Je n'ai pas trouvé de cas avec erreur pour le moment, et le code est plus "académique" en comparaison de mon test de variable Temp...
Par quoi puis je remplacé le CountIf = 0, afin de faire un test "différent de rien" ?
En effet les cellules où se trouve des personnages ou objet seront "remplies" avec une donnée particulière.
exemple les 4 Héros seront codés H1, H2, H3 et H4, les monstres seront codés avec un nom correspondant à leur emplacement initial : MD4, ou MF12, les murs avec un 0 (celui-là est géré actuellement). La règle des sorts stipule que le sort peut être lancé sur un personnage que si entre le lanceur et la cible il n'y a pas d'autre personnage ou de mur. Il faudrait pouvoir faire un test sur les 0 mais également sur ce qui commence par un H ou un M.
Dernier point, en suivant la "courbe" du connecteur, est-il possible de déplacer un shape sur cette courbe pour simuler "un tir" ?
J'ai déjà réussit à faire suivre un shape sur une ligne "à main levée" sur laquelle j'avais ajouter des points, mais sur le connecteur je n'y parvient pas, le ".Count" des nodes me donne 0...
L'idée serait de "calculer" le connecteur, d'en récupérer les caractéristiques (ce que vous faites déjà) puis utiliser ces caractéristique pour aller de l'enchanteur vers la cible et d'animer un shape représentant le sort afin de simuler le tir.
Je comprends que j'en demande beaucoup... Prenez votre temps.
Je continue les tests, et pour ce qui est de la rapidité, le code ne fonctionnera que monstre après monstre :
en effet l'idée est la suivante : l'enchanteur joue, décide de lancer un sort, on lui demande de choisir la cible, en cliquant sur les monstres visibles le code lui indiquera si le lancé est possible ainsi que le "reste de vie" du monstre.
Ceci est déjà mis en place sur le fichier ci-dessous, mais ce dernier ne reprend pas encore le nouveau code :
Il faut initialiser le "jeu" puis après cliquer sur lancer un sort et suivre les informations de ce bouton.
@ bientôt
LouReeD
Nota : le mot plaintes est un peu fort, non ?
re,
au lieu de countif avec 0, on peut utiliser CountA pour vérifier si la/les cellule(s) n'est pas vide. Mais c'est ambetant, je pense que tu mets un H ou un M dans la cellule "topleftcell" d'un héro ou "squelette" mais je dois ignorer cela pour les 2 shapes que tu veux contrôler. Ce n'est pas si facile.
bon, en PJ,
- la macro "M_Test_move" (autrement avec ce bouton, lignes 30-40) pour déplacer un des 2 shapes sur le connecteur. Pour le moment, dans cette macro, on a 4 MOVEs, avec une distance positive (s'approcher) ou négative (s'éloigner) et avec ou sans temps d'exécution. Cette macro utilise la macro paramétrée "M_Move" qui crée une déplacement fluïde si tu demande une déplacement pendant une période. Je ne sais pas comment tu voulais simuler "un tir" ? Quelque chose pareil ?
- Pour vérifier s'il n'y a pas d'autres objets entre vos 2 shapes, j'ai par exemple ma fonction "f_obstruction_Formes" avec les 2 shapes concernés qui teste s'il n'y a pas d'autres formes entre les 2. Testes par exemple la macro "M_entre" qui vérifie si "Hero" peut tirer sur "Squelette2" et la réponse est "Squelette2", ce qui veut dire que "squelette2" se trouve pour une partie sur le connecteur entre les 2 shapes. Avecl'ancienne macro "Test_BSALV", tu verras que squelette1 est après un mur et squelette 3 cache squelette 2 pour le hero. Comme ça, je pense que c'et plus facile à gèrer sans des "M"ou "H" dans les cellules. C'est encore en version-teste parce que je connais pas bien ta situation.
Bonsoir,
encore une fois merci ! Il faut que je m'imprègne de votre code afin de trouver où se trouve le calcul des points du connecteur afin d'y placer le shape.
Ensuite le point à point est "trop" lent un pas de 5 ou 10 devrait faire l'affaire, avec une tempo plus rapide.
Sinon avec un ancien code pour les valeurs inscrites au niveau des cellules où se trouve les shapes, j'avais fait ceci :
Sub Test_BSALV()
Dim Temp, Arr, N, i
N = 4
ReDim Arr(1 To N, 1 To 3)
For i = 1 To N
ActiveSheet.Shapes("Squelette" & i).TopLeftCell = ""
ActiveSheet.Shapes("Hero").TopLeftCell = ""
Temp = F_Test(ActiveSheet.Shapes("Hero"), ActiveSheet.Shapes("Squelette" & i), ActiveSheet.Shapes("Connecteur_S" & i))
Arr(i, 1) = "Squelette" & i
Arr(i, 2) = Temp(0)
Arr(i, 3) = Temp(1)
ActiveSheet.Shapes("Squelette" & i).TopLeftCell = ActiveSheet.Shapes("Squelette" & i).Name
ActiveSheet.Shapes("Hero").TopLeftCell = ActiveSheet.Shapes("Hero").Name
Next
End SubEn fait, les shapes héros et Monstres seront plus petit que la cellule, et leur "déplacement" sera géré par code VBA donc à l'issue leur positionnement sur les "grandes cellules" sera centré, donc un TopLeftCell me permet simplement de connaitre la cellule dans lesquelles en début de code il faut effacer les données et dans lesquelles il faut les inscrire. Là je n'ai pas pris en compte que le monstre puisse être détruit. C'est d'ailleurs pour cela que je vous avais parlé de prendre le centre de la cellule et non pas celui du shape... Mais ce côté là de la chose je devrais pouvoir y arriver.
Je vais travailler sur votre proposition et je vous tiens au courant si le cœur vous en dit !
@ bientôt
LouReeD
Bonsoir,
votre code de déplacement digéré dans le sens de ma recherche :
Sub M_Move(shp1 As Shape, shp2 As Shape)
Dim aX(1), aY(1), Shp As Shape
With shp1
aX(0) = CDbl(.Left + .Width / 2) 'center de shp1
aY(0) = CDbl(.Top + .Height / 2)
End With
With shp2
aX(1) = CDbl(.Left + .Width / 2) 'center de shp2
aY(1) = CDbl(.Top + .Height / 2)
End With
Set Shp = ActiveSheet.Shapes("Feu")
Shp.Left = aX(0) + (aX(1) - aX(0)) * (1 / 20) - Shp.Width / 2
Shp.Top = aY(0) + (aY(1) - aY(0)) * (1 / 20) - Shp.Height / 2
Shp.Visible = True
For i = 2 To 20
Shp.Left = aX(0) + (aX(1) - aX(0)) * (i / 20) - Shp.Width / 2
Shp.Top = aY(0) + (aY(1) - aY(0)) * (i / 20) - Shp.Height / 2
tempo = Timer
Do
DoEvents
Loop While tempo + 0.004 > Timer
Next i
Shp.Visible = False
End SubLe fichier avec quelques modifications où l'on voit le tir sur les cibles "vertes" :
Merci encore à vous !
J'obtiens bien une boule de "feu" qui suit le connecteur liant en fait il ne le suit pas car le connecteur je ne le crée plus, la boule de feu suit la trajectoire définie par la les caractéristiques de cette dernière qui relie les deux shapes du Hero vers la cible qui peut être touchée !
@ bientôt
LouReeD
Edit : nouvelle version du fichier avec clic gauche sur les monstres pour voir leur endurance, clic sur le bouton lancer un sort, clique sur le monstre choisi pour lancer le sort, réduction de l'endurance du monstre en fonction de la distance du héro, et destruction du monstre si endurance <=0 :
Merci BsAlv, j'avance dans la bonne direction ou du moins celle que j'ai choisi ! Ceci en plus du lancé de dés, les "hics" de ce projet s'estompent de jour en jour !
@ bientôt
LouReeD