Problème limites

cs_Clemzinho Messages postés 9 Date d'inscription jeudi 12 juillet 2012 Statut Membre Dernière intervention 8 mai 2013 - 13 juil. 2012 à 21:54
cs_Clemzinho Messages postés 9 Date d'inscription jeudi 12 juillet 2012 Statut Membre Dernière intervention 8 mai 2013 - 18 juil. 2012 à 14:33
Bonjour,
A partir de flêche (objets), je cherche à représenter des segments perpendiculaires à la place des extrémités en flêches ("t"). Je suis débutant en VBA; et ai besoin d'un coup de main...

J'essaye en vain d'utiliser ce code trouvé sur internet, mais j'ai le message d'erreur suivant: "Erreur de temps d'exécution'-24147024809 (80070057)'
L'indice de l'ensemble spécifié est en dehors des limites" (traduit du portugais)

Auriez vous une solution pour résoudre cela? Merci pour vos conseils!

voici le code que j'utilise:
Sub genererTraitPerpendiculaire()
 
    Dim tailleTrait As Single
    Dim tabPoints()
    Dim tabPoints1() As String
    Dim tabPoints2() As String
    Dim normeV2
    Dim v1(2) As Single
    Dim x1, x2, y1, y2
    Dim j As Integer
    Dim v2 As Variant
 
 
    Dim nomForme As String
 
    nomForme = Selection.ShapeRange.Name
    tailleTrait = 5
 
    With Worksheets("Plan1")
 
        ReDim tabPoints(2, 2)
        'enlève la flêche
        .Shapes(nomForme).Line.EndArrowheadStyle = msoArrowheadNone
        'donne a Tabpoints1 les coordonnées du 1er noeud
        tabPoints1 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count - 1).points
        'donne a Tabpoints2 les coordonnées du 2nd noeud
        tabPoints2 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count).points
 
 
            For j = 1 To 2
                tabPoints(1, j) = tabPoints1(1, j)
                tabPoints(2, j) = tabPoints2(1, j)
            Next j
 
 
        v1(1) = tabPoints(1, 1) - tabPoints(2, 1)
        v1(2) = tabPoints(1, 2) - tabPoints(2, 2)
        v2 = vectOrthogonal(v1)
        normeV2 = v2(0) * v2(0) + v2(1) * v2(1)
        normeV2 = Sqr(normeV2)
        v2(0) = v2(0) / normeV2
        v2(1) = v2(1) / normeV2
 
        v2(0) = tailleTrait * v2(0)
        v2(1) = tailleTrait * v2(1)
 
        x1 = tabPoints(2, 1) - v2(0)
        x2 = tabPoints(2, 1) + v2(0)
        y1 = tabPoints(2, 2) - v2(1)
        y2 = tabPoints(2, 2) + v2(1)
        .Shapes.AddLine(x1, y1, x2, y2).Select
    End With
End Sub


Clément

10 réponses

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
13 juil. 2012 à 22:07
Bonjour,
Impossible de te répondre sur la seule base des informations que tu nous donnes !
Quelles formes sont présentes sur ta feuille ?
Quelle est la ligne d'erreur ?


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
cs_Clemzinho Messages postés 9 Date d'inscription jeudi 12 juillet 2012 Statut Membre Dernière intervention 8 mai 2013
13 juil. 2012 à 22:13
Merci pour ton intérrêt "ucfoutu"

Les formes sont simplement des flêches.

La ligne d'erreur est la suivante:

Sub genererTraitPerpendiculaire()
 
    Dim tailleTrait As Single
    Dim tabPoints()
    Dim tabPoints1() As String
    Dim tabPoints2() As String
    Dim normeV2
    Dim v1(2) As Single
    Dim x1, x2, y1, y2
    Dim j As Integer
    Dim v2 As Variant
    
    
    Dim nomForme As String
 
    nomForme = Selection.ShapeRange.Name
    tailleTrait = 5
 
    With Worksheets("Plan1")
 
        ReDim tabPoints(2, 2)
        'enlève la flêche
        .Shapes(nomForme).Line.EndArrowheadStyle = msoArrowheadNone
        
        tabPoints1 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count - 1).points
       
        tabPoints2 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count).points
 
 
            For j = 1 To 2
                tabPoints(1, j) = tabPoints1(1, j)
                tabPoints(2, j) = tabPoints2(1, j)
            Next j
 
 
        v1(1) = tabPoints(1, 1) - tabPoints(2, 1)
        v1(2) = tabPoints(1, 2) - tabPoints(2, 2)
        v2 = vectOrthogonal(v1)
        normeV2 = v2(0) * v2(0) + v2(1) * v2(1)
        normeV2 = Sqr(normeV2)
        v2(0) = v2(0) / normeV2
        v2(1) = v2(1) / normeV2
 
        v2(0) = tailleTrait * v2(0)
        v2(1) = tailleTrait * v2(1)
 
        x1 = tabPoints(2, 1) - v2(0)
        x2 = tabPoints(2, 1) + v2(0)
        y1 = tabPoints(2, 2) - v2(1)
        y2 = tabPoints(2, 2) + v2(1)
        .Shapes.AddLine(x1, y1, x2, y2).Select
    End With
End Sub
 
Function vectOrthogonal(vect)
' Renvoie un vecteur orthogonal au vecteur vect
    Dim tabPointsTemp()
    ReDim tabPointsTemp(2)
 
 
    If vect(2) = 0 Then
        xprime = 0
        yprime = 1
    Else
        xprime = 1
        yprime = vect(1) / vect(2)
        yprime = yprime * (-1)
    End If
    tabPointsTemp(0) = xprime
    tabPointsTemp(1) = yprime
    vectOrthogonal = tabPointsTemp
End Function



Clément
0
cs_Clemzinho Messages postés 9 Date d'inscription jeudi 12 juillet 2012 Statut Membre Dernière intervention 8 mai 2013
13 juil. 2012 à 22:14
Désolé, la couleur n'a pas marché, il s'agit de la ligne:

tabPoints1 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count - 1).points

Merci
Clément
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
13 juil. 2012 à 22:48
J'ai comme la vague impression que tu as recopié cette ligne :
ReDim tabPoints(2, 2)

sans en connaître la signification
Il s'agit d'un dimensionnement de tableau dynamique, qui correspond à un contexte qui n'est probablement pas le tien.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
cs_Clemzinho Messages postés 9 Date d'inscription jeudi 12 juillet 2012 Statut Membre Dernière intervention 8 mai 2013
13 juil. 2012 à 22:53
C'est juste...j'ai déjà eu ce problème, et l'avais résolu en déclarant des variables ...

Voici le code original, sans modification des variables, qui me donne la même erreur...En fait, je ne comprend pas les lignes tabpoints1 et tabpoints2.

Sub genererTraitPerpendiculaire()
 
    Dim tailleTrait As Single
    Dim tabPoints()
    Dim v1(2) As Single
    Dim x1, x2, y1, y2
 
    Dim nomForme As String
 
    nomForme = Selection.ShapeRange.Name
    tailleTrait = 5
 
    With Worksheets("Feuil1")
 
        ReDim tabPoints(2, 2)
 
        .Shapes(nomForme).Line.EndArrowheadStyle = msoArrowheadNone
 
        tabPoints1 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count - 1).Points
        tabPoints2 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count).Points
 
 
            For j = 1 To 2
                tabPoints(1, j) = tabPoints1(1, j)
                tabPoints(2, j) = tabPoints2(1, j)
            Next j
 
 
        v1(1) = tabPoints(1, 1) - tabPoints(2, 1)
        v1(2) = tabPoints(1, 2) - tabPoints(2, 2)
        v2 = vectOrthogonal(v1)
        normeV2 = v2(0) * v2(0) + v2(1) * v2(1)
        normeV2 = Sqr(normeV2)
        v2(0) = v2(0) / normeV2
        v2(1) = v2(1) / normeV2
 
        v2(0) = tailleTrait * v2(0)
        v2(1) = tailleTrait * v2(1)
 
        x1 = tabPoints(2, 1) - v2(0)
        x2 = tabPoints(2, 1) + v2(0)
        y1 = tabPoints(2, 2) - v2(1)
        y2 = tabPoints(2, 2) + v2(1)
        .Shapes.AddLine(x1, y1, x2, y2).Select
    End With
End Sub
 
Function vectOrthogonal(vect)
' Renvoie un vecteur orthogonal au vecteur vect
    Dim tabPointsTemp()
    ReDim tabPointsTemp(2)
 
 
    If vect(2) = 0 Then
        xprime = 0
        yprime = 1
    Else
        xprime = 1
        yprime = vect(1) / vect(2)
        yprime = yprime * (-1)
    End If
    tabPointsTemp(0) = xprime
    tabPointsTemp(1) = yprime
    vectOrthogonal = tabPointsTemp
End Function


Clément
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
13 juil. 2012 à 22:54
je trouve par ailleurs assez étranges ces deux lignes :
Dim tabPoints1() As String
Dim tabPoints2() As String

qui ne devraient à mon sens pas être ainsi déclarées "dimensionnées" (mles (parenthèses et le type) comme tu le fais.
M'étonnerait fort que tu aies vu ces deux lignes ainsi écrites là où tu as trouvé ce code.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
13 juil. 2012 à 23:00
Retourne s'il te plait là où tu as ramassé ce bout de code.
Il est vraisemblable qu'il correspond à un contexte (lequel ?) qui n'est pas le tien ! (existence d'une collection ? de groupes ? d'une classe, etc ...).
Il n'est pas possible de faire les choses "à l'envers" : déterminer les tenants originels (ceux qui correspondaient à ce code) avec précision à partir d'un bout de code !


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
cs_Clemzinho Messages postés 9 Date d'inscription jeudi 12 juillet 2012 Statut Membre Dernière intervention 8 mai 2013
13 juil. 2012 à 23:05
ok. Cela expliquerait une erreur d'"indice en dehors des limites?"

Est-il possible que tabPoints1 e tabPoints2 soient définis autre part? Comment pourraient-ils l'être? De cette manière, et si le problème vient de là, je dois pouvoir les redéfinir dans ce code, non?

Je pensais que ce type d'erreur trouverait une réponse dans ce code. merci.


Clément
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 juil. 2012 à 22:25
DSésolé, mais je n'en sais rigoureusement rien. Et encore moins si toi, tu te contentes de partir en tentant
en vain d'utiliser ce code trouvé sur internet

Relis donc ma réponse plus haut ! Pour mémoire :
Retourne s'il te plait là où tu as ramassé ce bout de code.
Il est vraisemblable qu'il correspond à un contexte (lequel ?) qui n'est pas le tien ! (existence d'une collection ? de groupes ? d'une classe, etc ...).
Il n'est pas possible de faire les choses "à l'envers" : déterminer les tenants originels (ceux qui correspondaient à ce code) avec précision à partir d'un bout de code !

La seule chose que je vois clairement, dans de telles conditions, est que :
Dim tabPoints1() As String
Dim tabPoints2() As String

est impossible dès lors qu'ensuite, tu écris :
tabPoints1 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count - 1).points/color

tabPoints2 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count).points

Dans mon esprit, ces deux tableaux ne sauraient ni être dimensionnés (les parenthèses), ni typés (autrement qu'en variant).
Je note d'ailleurs que c'est toi (et toi seul) qui les a typés et dimensionnés !
Voilà voilà ...
Désolé, mais ma tasse de vthé n'est jamais de "partir" de bouts de codes ramassés sur le Net.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
cs_Clemzinho Messages postés 9 Date d'inscription jeudi 12 juillet 2012 Statut Membre Dernière intervention 8 mai 2013
18 juil. 2012 à 14:33
Merci pour ton aide. En fait, je travaille sur un code complet qui me pose le même problème de "limites". Ainsi, je pensais résoudre ce problème en utilisant un autre code trouvé sur internet (mais incomplet) qui a le même objectif.

Je vais continuer mes recherches pour découvrir ce qu'est ce problème de limites.

Bonne continuation,


Clément
0
Rejoignez-nous