[Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les amis

[Staple1600]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re


Après des tâtonnements, voilà ou j'en suis
(cela renvoie bien le nom des groupes et le noms des formes contenus dans ces groupes)

Sub ENUM_FORMES()
Dim Shp As Shape, i As Byte
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoGroup Then
For i = 1 To Shp.GroupItems.Count
s = s & Shp.Name & ": " & vbTab & Shp.GroupItems.Item(i).Name & Chr(13)
Next i
End If
Next
MsgBox s, vbInformation + vbOKOnly, "RESULTATS"
End Sub

Mais je ne vois pas comment m'en servir avec :

Sub toto()
MsgBox Application.Caller & Chr(10) & Feuil1.Shapes(Application.Caller).ParentGroup.Name
End Sub

 

[Mytå]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re le forum

Staple1600, il faudrait voir avec les versions supérieur à 2000, si cela fonctionne.

Attendons d'autres testeurs....

Le fichier était assez bien fait pour une utilisation juste à la souris.

Mytå

 

[Mytå]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re le forum

Staple1600, ensuite je me lance sur la création de grille en Macro.

Mais, ca sera une autre problématique pour créer l'organigrame...

Mytå

 

[Staple1600]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re

Je ne doute pas que ton fichier soit tip top 😉

Mais avec Excel 2000, je ne peux pas le tester en l'état

car quand je clique sur un domino , il ne se passe rien (l'userform ne s'affiche pas)

En cherchant sur le net, je suis sur maintenant que ParentGroup n'apparait que dans les versions supérieures à Excel 2000.

 

[Mytå]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re le forum

Staple1600, un autre essai, modifie le code de cette macro.

Private Sub ActionSurShape()

Groupe = Application.Caller
 [COLOR="Red"]If Groupe = "Initialisation" Then Exit Sub[/COLOR]
Set Shp = ActiveSheet.Shapes("Groupe" & Right(Groupe, 2))

Et remplace l'ancienne macro

Private Sub MacroPourShape()
 'Appliquer la macro "ActionSurShape" aux Dominos
    
  For Each Shp In ActiveSheet.Shapes
    Shp.OnAction = ""
       Shp.OnAction = "ActionSurShape"
  Next Shp
  
End Sub

Mytå

P.S. Je n'utilise pas ParentGroup dans les macros

 

[Staple1600]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re

Je vais modifier de suite et redit ensuite

Car je ne comprends pas pourquoi il fonctionne mal (à mon sens)

Edition: finalement, j'ai compris grâce à Lone-Wolf 😉

 

[Staple1600]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re

Toujours rien

Si je clique sur Initialisation , il se passe rien

Si je retire les Private et que je lance une à une les macros (bug)
Si j'affiche l'userform à partir de vbe, bug aussi.


Et en ne touchant à rien dans le code VBA, sauf appliquer les modifs de ton dernier message, il ne passe rien quand je clique soit sur dominos soit le bouton Initialisation.

 

[Mytå]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re le forum

Staple1600, sous Excel 2003 aucun problème sans modification du programme.

Sinon que le UserForm est pas visible

With Dominos
      .StartUpPosition = 0
      .Top = 10
      .Left = 10

Mytå

P.S. Je test ta version

 

[Staple1600]

Re : [Amusement] Science et vie BIS, les dominos et VBA, venez vous y coller, les ami

Re

EDITION: je viens de comprendre d'où venait le problème ... 😱 🙄 ...De mon moniteur !! (un 22 pouces et de sa résolution ) .
Avec ces réglages, c'est bon pour moi

.StartUpPosition = 0
.Top = 130
.Left = 400
​

Avec ces modifs, il se passe enfin quelquechose 🙂

Call Extraction

Sub ActionSurShape()
'Macro pour les Dominos
Dim I As Byte, Nom$, Rng As Range
Groupe = Application.Caller
If Groupe = "Initialisation" Then Exit Sub
Set Shp = ActiveSheet.Shapes("Groupe" & Right(Groupe, 2))
With Dominos
'.StartUpPosition = 0
'.Top = 180
'.Left = 800

PS: Encore bravo, pour la qualité de ton code, j'ai pris le temps de le lire en entier
(j'aurai du commencer par là au lieu de bêtement cliquer sur mon mulot 😉 )