Affecter des macros à des shapes

Bonjour,

je dispose d'une carte et je dois faire un traitement à chaque fois que je clique sur un pays. Malheureusement la macro que j'ai fait ne marche pas et j'obtiens l'erreur suivante

"Run-time error '1004':

Application-defined or object-defined error"
je ne comprends absolument d'ou viens l'erreur je me suis aidé pourtant de l'enregistreur de macro

voilà le code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub AffecterMacro() Dim loShape As Shape ' Forme Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte ") For Each loShape In Carte.Shapes("Carte").GroupItems loShape.OnAction = "AffecterValeur(" & loShape.Name & ")" Next End Sub   Sub AffecterValeur(Country As String) Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte ") Carte.Range("P4").Value = Country End Sub

---

Merci d'avance pour votre aide

Bonjour,

et quelle ligne déclenche l'erreur ?

Salut,

la ligne 6 :

Code:

---

loShape.OnAction = "AffecterValeur(" & loShape.Name & ")"

---

Effectivement, il y a une erreur dans la déclaration de la propriété OnAction à cause des parenthèses !
Qui plus est, il n'est pas possible de passer un paramètre … :fleche: Voir post #7 !

Contournement :

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub AffecterMacro() Dim loShape As Shape For Each loShape In ThisWorkbook.Worksheets("Afrique - Carte ").Shapes("Carte").GroupItems loShape.OnAction = "AffecterValeur" Next End Sub   Sub AffecterValeur() V = Application.Caller If Not IsError(V) Then ThisWorkbook.Worksheets("Afrique - Carte ").[P4].Value = V End Sub

---

__________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

merci pour l'aide mais un pb persiste encore

la fonction AffecterValeur marche bien en revanche j' obtiens tjrs une erreur pour la fonction AffecterMacro

Code:

---

1 2 3 4 5 6

Sub AffecterMacro() Dim loShape As Shape For Each loShape In ThisWorkbook.Worksheets("Afrique - Carte ").Shapes("Carte").GroupItems loShape.OnAction = "AffecterValeur" Next End Sub

---

j'ai une tjrs la mm erreur

"Run-time error '1004':

Application-defined or object-defined error" qui porte sur cette ligne

Code:

---

loShape.OnAction = "AffecterValeur"

---

J'ai testé rapidement sur des objets Shape individuels, non groupés, peut-être en est-ce la raison …

Évidemment si la feuille est protégée …

Bonjour
peut être comme ceci:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub AffecterMacro() Dim loShape As Shape ' Forme Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte ") For Each loShape In Carte.Shapes("Carte").GroupItems loShape.OnAction = "'AffecterValeur """ & loShape.Name & """'" Next End Sub Sub AffecterValeur(Country As String) Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte ") Carte.Range("P4").Value = Country End Sub

---

Au plaisir

Salut Patrick !

As-tu procédé à un test ?

De mon côté sur une version 2003, ton affectation de macro avec passage de paramètre ne provoque pas d'erreur
mais lors du clic sur l'image, cela en provoque une : « Impossible de trouver la macro … »

Bonjour MarcL

c'est bizarre je me sert de cette façon pour mes command bars et shapes et chez moi ca fonctionne

bien que je n'est pas tester sa macro je vais me faire un exemple et on verra bien

C'est bien ce que je pensais
ouvre un new fichier
met lui des shapes nome les
et colle ceci dans un module standard
lance la macro

et clique sur chaque shapes tu verra bien

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Sub AffecterMacro() Dim loShape As Shape ' Forme Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets(1) For Each loShape In Sheets(1).Shapes loShape.OnAction = "'AffecterValeur """ & loShape.Name & """'" Next End Sub   Sub AffecterValeur(Country As String) MsgBox Country End Sub

---

re derniere fois
c'était bien ce que je pensais
l'erreur venait de l'intitulé de sa boucle
il n'a pas besoin de preciser qu'elle sont groupée

allez voila tester et reussi 100%

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub AffecterMacro() Dim loShape As Shape ' Forme Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte") For Each loShape In Carte.Shapes 'ton erreur était ici loShape.OnAction = "'AffecterValeur """ & loShape.Name & """'" ' et ici Next End Sub   Sub AffecterValeur(Country As String) Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte") Carte.Range("P4").Value = Country End Sub

---

bon dimanche

Autant pour moi Patrick !

Je n'étais pas dans un module standard, j'ai oublié de préciser le CodeName de la feuille,
la tête dans le gaz depuis ce matin …

Super, on peut donc passer un paramètre avec une macro !

:plusser:

CADEAU!!!!!

Allez je m'ennuie alors voila un exemple avec 3 argument
en fait dans une macro en dur si on fesait appel a une autre macro ou fonction on écrirait comme ca

Code:

---

1 2 3 4 5 6 7

sub appel_a_la_fonction() truc chose1,chose2,chose3 end sub   function truc( machin1,machin2,machin3) 'reste du code pour employer les argument end function

---

en fait pour le on action il suffit
1° de mettre "'" & " devant le nom de la macro et " & """" justeaprès le nom de la macro et avant le premier argument


2° remplacer la virgule par """, " & """" &


3° terminer par & """" & "'"après le dernier argument

c'est vraiment un bon dimanche non?

Allons y teston cela

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Sub AffecterMacro() Dim loShape As Shape ' Forme Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte") For Each loShape In Carte.Shapes 'ton erreur était ici macro_avec_arguments = "'" & "AffecterValeur " & """" & loShape.Name & """, " & """" & loShape.TopLeftCell.Address & """, " & """" & loShape.Height & """" & "'"   loShape.OnAction = macro_avec_arguments 'loShape.OnAction = "'AffecterValeur """ & loShape.Name & """'" ' et ici Next End Sub   Sub AffecterValeur(Country As String, pos, largeur) Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte") Carte.Range("A1").Value = Country Carte.Range("B1").Value = pos MsgBox "cette shapes s'appelle " & Country & vbCrLf & " sa position topleftcell est " & pos & vbCrLf & "sa largeur est egale a " & largeurEnd Sub

---

Au plaisir

Si l'un des arguments contient ", il faudra prévoir cela

Allez, je te donne Patrick un petit exercice pour que ne t’ennuie pas

Bonjour mercatog:mouarf::mouarf:

je l'attendait pas celle la !!!:mouarf:

dans le onaction on pourrait faire un replace sur argument

exemple replace(argument,chr(34),"""")
et si ca suffit pas ajouter & de chaque coté
enfin ca doit être un truc du genre
le guillemet serait alors pris en compte


:ptdr::ptdr::ptdr::ptdr::ptdr::ptdr::ptdr::ptdr:

Allez Patrick, concoctez nous un bijou

Citation:

---

Envoyé par patricktoulon

re derniere fois
c'était bien ce que je pensais
l'erreur venait de l'intitulé de sa boucle
il n'a pas besoin de preciser qu'elle sont groupée

allez voila tester et reussi 100%

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub AffecterMacro() Dim loShape As Shape ' Forme Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte") For Each loShape In Carte.Shapes 'ton erreur était ici loShape.OnAction = "'AffecterValeur """ & loShape.Name & """'" ' et ici Next End Sub   Sub AffecterValeur(Country As String) Dim Carte As Excel.Worksheet ' Feuille Set Carte = ThisWorkbook.Sheets("Afrique - Carte") Carte.Range("P4").Value = Country End Sub

---

bon dimanche

---

bonjour ,

j'ai essayé le code et effectivement ça compile sans aucune erreur cela dit j'ai un pb avec ce code

Code:

---

For Each loShape In Carte.Shapes

---

puisque la boucle affecte une macro à toute les shapes de la page y compris les graphiques et les bouton d’exécution

c'est pour ça que j'avais mis

Code:

---

For Each loShape In Carte.Shapes("Carte").GroupItems

---

car je veux qu'il s'applique uniquement sur ma carte géographique et sur les pays associées, de plus lorsque je clique sur un pays de la carte ca retourne dans la cellule P4 le nom de ma carte et non le nom du pays selectionné

voici une petite fonction qui vous montre comment écrire le code du .onaction afin d'y affecter une macro avec arguments

Attention je dis bien comment l'ecrire ..... pas comment il est interpreté

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub test() nom_de_la_macro = "ma macro" arguments = "param1,param2,param3" 'ect...autant d'argument que vous voulez separés par une virgule texte = macro_argumentée(nom_de_la_macro, arguments) MsgBox texte End Sub   Function macro_argumentée(nommacro, arguments) arguments = Replace(arguments, ",", " & " & """"""", """ & " & " & """""""""" & " & ") macro_argumentée = """'""" & nommacro & " "" & """""" " & " & " & arguments & " & " & """""""""" & " & " & """'""" End Function

---

je vous fait une builder"procc+arguments" et je reviens bien que j'ai déjà vu ici et la des versions existante faisant la meme chose

Bonjour
je viens de tester plusieurs modèles et il semblerait bien que si les shapes sont groupées on ne peut qu'utilise la boucle sur le shapes.count
mais le shapes revient toujours a sélectionner le groupe

d'ailleurs sur le sheets lui même quand on sélectionne un des shapes on sélectionne le groupe entier


il faut donc modifier la boucle sur les shapes afin qu'elle ne prenne en compte que celle qui sont voulue

peut être en mettant un préfixe au identique a chaque shapes voulue et mettre la condition dans la boucle et en les dégroupant bien sur

dans l'état actuel je ne vois pas comment faire autrement

Citation:

---

Envoyé par patricktoulon

Bonjour
je viens de tester plusieurs modèles et il semblerait bien que si les shapes sont groupées on ne peut qu'utilise la boucle sur le shapes.count
mais le shapes revient toujours a sélectionner le groupe

d'ailleurs sur le sheets lui même quand on sélectionne un des shapes on sélectionne le groupe entier


il faut donc modifier la boucle sur les shapes afin qu'elle ne prenne en compte que celle qui sont voulue

peut être en mettant un préfixe au identique a chaque shapes voulue et mettre la condition dans la boucle et en les dégroupant bien sur

dans l'état actuel je ne vois pas comment faire autrement

---

effectivement ça marche bien en dégroupant les shapes

merci beaucoup pour votre aide