[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 )