VBA : Ellipse (et plus si affinité...)

Bonjour,

Encore un dimanche de m... sous la pluie !

BsAlv : Oui mais l'idée générale de SreenUpdating c'est pas de le mettre à True puis de déprotéger ! Encore un truc qui était pas mal et qui se barre en c... C'est comme la Gestion d'erreurs, maintenant c'est en train de passerau rayton des antiquités...

Bon enfin je chipote. de toute façon, je redéfinirai à chaque fois la position de l'ovale comme ça, même si elle a bougé un peu, ça ma la recalera au bon endroit.

LouReed : Très bien. Je n'est pas tout épluché dans le code et je ne sais pas encore si c'est facile à la création ou s'il faudra une deuxième passage sur le tableau pour écrie au niveau des Data et mettre une colonne pour le contenu "Lettre" de chaque Hexa et une autre libre pour le Tag. Sinon je les mettrai moi-même en colonne 13 et 14. Pour l'instant je n'ai pas encor tout calculé pour le Tag, mais j'avais déjà utilisé une routine de ce genre et je l'ai conservée dans mes archives. J'aurai donc juste à me rafraichir un peu la mémoire... Mais je verrai ça la semaine prochaine !

A+

Lou : Comme je te sens bien parti sur ce coup... Pour le Tag l'idée c'est d'avoir la somme de contrôle des voisins ou

O = 1

N0 = 2

NE = 4

E = 8

SE = 16

SO = 32

ainsi un Hex qui a ses 6 voisins aura une somme de contrôle de 63 et les autres des sommes diverses selon les emplacements...

Hex001 par exemple aura un Tag de 56 (32+16+8)

A+

BsAlv : C'est peut-être plus la peine de t'acharner pour quelques millièmes de secondes. L'idée n'étant pas de faire un concours entre vous deux !

A+

Bonjour,

Une colonne ajoutée pour les lettres dans le tableau DATA, et une autre pour la somme des voisins avec cette formule :
=SOMMEPROD((SI(TabSRC[@[O]:[SO]]<>"";2^(COLONNE(TabSRC[@[O]:[SO]])-8);0))*1)

Le moins 8 sera à modifier s'il y a ajout ou suppression de colonne afin que la puissance de 2 soit la bonne.

Le fichier :

Après avec BsAlv, oui il y a de mon côté une recherche d'amélioration sur la vitesse quand je vois que d'autre façon de faire vont plus vite, sans pour autant que ce soit une "compétition" ! Mais ce qui me "chagrine" c'est la différence de rendu des codes. Moi je parts d'en haut à gauche avec un décalage vertical afin que la ligne "impaire" soit centrée sur l'axe horizontal de l'ellipse. BsAlv, vous partez du centre et vous remontez de l'entier du nombre de shape /2.
C'est une deuxième différence... C'est étrange...

@ bientôt

LouReeD

re, la symétrie de BSALV (hexas en noir) et de LouReeD (hexas en rouge) = décalé 1/2 hexa vers gauche (ou droite), ils sont tous les 2 symétriques

Discussion concernant le sexe de anges, lequel préfère-t-on ?

Donc c'est bien ce que je pensais, vous partez d'un hexagone centré sur l'ellipse et de là vous créez les autres. mais du coup vous pouvez perdre un shape en largeur sur cette ligne d'axe horizontal de l'ellipse, car une fois centré comme ceci vous pouvez avoir de chaque côté 0.75 shape donc aucun car à cheval, mais si vous centrez "entre deux" shape alors les 1.5 shape peuvent en inscrire un de plus et reste 0.5 qui seront alors divisés en deux avec 0.25, non ?

De mon côté je part d'en haut à gauche avec un décalage vertical et horizontal tant et si bien que si j'ai un nombre impaire en largeur je me retrouve dans le même cas de figure que vous, et s'il y a un nombre paire alors je me retrouve dans le cas ci dessus avec en horizontal un centrage entre deux shapes.

Bravo @ vous d'avoir pu mettre en image cette différence !

@ bientôt

LouReeD

Oui bien que n'ai eu que très peu de temps à y consacrer je m'étais rendu compte en regardant les Data qu'une seimple formule me donnait le Taf.

Merci.

Sujet clos pour moi.

A+

Bonsoir,

modification de l'EventClik : Vu que les shapes sont créés dans l'ordre croissant et que le tableau est construit dans le même sens pour le shape Hex037 ses données sont en ligne 37 du tableau TabSRC ! C'est plus simple que le Find !

Sub EventClick()
    Dim LeShape, Texte As String, Voisin As String, I, Ligne, Tablo
    Tablo = Array("O", "NO", "NE", "E", "SE", "SO")
    LeShape = Application.Caller
    Ligne = Val(Right(LeShape, 3))
    ActiveSheet.Shapes(LeShape).Fill.ForeColor.RGB = RGB(255, 255, 0): DoEvents
    Texte = "Vous avez cliqué sur le shape n° : " & LeShape & Chr(10)
    Texte = Texte & "les shapes à ses côtés sont :" & Chr(10)
    For I = 0 To 5
        If Range("TabSRC").Cells(Ligne, 8 + I) <> "" Then
            Voisin = IIf(Voisin = "", "", Voisin & Chr(10)) & Tablo(I) & " : " & Range("TabSRC").Cells(Ligne, 8 + I)
        End If
    Next I
    Texte = Texte & Voisin & Chr(10) & "Le TAG est de : " & Range("TabSRC").Cells(Ligne, 14)
    MsgBox Texte
    ActiveSheet.Shapes(LeShape).Fill.ForeColor.RGB = RGB(112, 48, 160)
End Sub

Ensuite j'ai modifié les formules de colonnes "O" à "SO" pour y afficher le noms des shapes et non pas le code IDCL ! C'est plus simple pour les retrouver avec le même principe, si le shape Hex037 est voisin au au SE avec le shape Hex059, on trouvera les données de ce dernier en ligne 59 !

Le fichier modifié dans ce sens :

@ bientôt

LouReeD