ActiveSheet.Shapes(Application.Caller)

[Claude72]

Bonjour à tous,

Je voudrais créer un jeu de 421 sous Excel 2000.
Les dés sont des formes automatiques.
Avec un bouton (Lancer), les dés roulent sur le plateau. Jusque là pas de problème...
Ensuite il faut pouvoir cliquer sur un dé (si on veut le garder par exemple). Il devient alors rouge. Si on re-clique, il redevient ocre. Là est le problème...

J'aimerais que le curseur se transforme en "main", lorsqu'il survole un dé et que le dé devienne rouge si il est cliqué.
J'utilise ce qui suit mais ça ne fonctionne pas (code de la feuille)

ActiveSheet.Shapes(Application.Caller).Select
With Selection.ShapeRange
If .AlternativeText = "" Then
.AlternativeText = "garde"
.Fill.ForeColor.SchemeColor = 10
Else
.AlternativeText = ""
.Fill.ForeColor.SchemeColor = 26
End If
End With

Exemple.xls joint

Merci à vous

 

[MJ13]

Re : ActiveSheet.Shapes(Application.Caller)

Bonjour Claude, JM.

Celui de Claude à l'air plus réussi que celui en téléchargement proposé par Jean Marie.


Claude, propose le ensuite quand il sera fini (par contre je ne suis pas très doué pour ton problème).

 

[jeanpierre]

Re : ActiveSheet.Shapes(Application.Caller)

Bonsoir ou re selon,

Ah le fameux Robert René...........

Voir les archives du forum pour comprendre......

Bonne soirée.

Jean-Pierre

 

[Compte Supprimé 979]

Re : ActiveSheet.Shapes(Application.Caller)

Bonsoir tout le monde,

Claude72, pour faire avancé ta création, il suffit d'affecter une macro à chacun de tes dés, comme ça tu auras :

- le curseur en forme de main
- ton code d'incorporé dans la macro

Staple1600, ton dernier lien ne marche pas (en tout cas chez moi)

Oui, oui je sais, on va dire pourquoi réinventer la roue !?
Ben si claude à envie

A+

 

[Staple1600]

Re : ActiveSheet.Shapes(Application.Caller)

Re



En affectant ton code à ta shape ça fonctionne

Sub Dé1_QuandClic()
'pour test
MsgBox ActiveSheet.Shapes(Application.Caller).Name
ActiveSheet.Shapes(Application.Caller).Select
    With Selection.ShapeRange
        If .AlternativeText = "" Then
            .AlternativeText = "garde"
            .Fill.ForeColor.SchemeColor = 10
        Else
            .AlternativeText = ""
            .Fill.ForeColor.SchemeColor = 26
        End If
    End With
    Range("A1").Select
End Sub

BrunoM45: désolé j'avais pas rafraichi
Pourtant ce lien fonctionne
http://1960nene.free.fr/421.zip
(Mais personnellement j'aime pas - protection de chez protection- et non gratuit)

Je partage une avis similaire à celui de jeanpierre à propos de RR.

 

[jeanpierre]

Re : ActiveSheet.Shapes(Application.Caller)

Re, Bonsoir Bruno,

Pour finir sur RR, forum et question + réponses et applis déposées + CB = RR.

En formule cela donne ça : RR = questions posées + réponses apportées + CB

On peut aussi le faire en VBA.....

Pour Bruno et claude72, peut être limiter les temporisations de 1500000 et 2000000, un peu longuettes.

Bon WE tout le monde.

Jean-Pierre

 

[Staple1600]

Re : ActiveSheet.Shapes(Application.Caller)

Re

Claude72: (Suggestion)
Tu pourrais ajouter les règles du jeu et un historique des scores
En attendant, un petit interlude
[flash]http://a2bconcept.free.fr/a2bgames/jeux_finis/421.swf[/flash]

 

[Claude72]

Re : ActiveSheet.Shapes(Application.Caller)

OK ça fonctionne.
Il fallait affecter la macro suivante à chacun des dés :

Sub GarderDé()
ActiveSheet.Shapes(Application.Caller).Select
With Selection.ShapeRange
If .AlternativeText = "" Then
.AlternativeText = "garde"
.Fill.ForeColor.SchemeColor = 10
Else
.AlternativeText = ""
.Fill.ForeColor.SchemeColor = 26
End If
End With
Range("A1").Select
End Sub

Merci à vous les amis
A bientot