Discussion :

[huître]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Marc-L]

Bonjour,

et quelle ligne déclenche l'erreur ?

[huître]

Salut,

la ligne 6 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Marc-L]

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 … Voir post #7 !

Contournement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 pour chaque message ayant aidé puis sur pour clore cette discussion …

[huître]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

 loShape.OnAction = "AffecterValeur"

[Marc-L]

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 …

[patricktoulon]

Bonjour
peut être comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Marc-L]

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 … »

[patricktoulon]

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

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Marc-L]

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 !

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mercatog]

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

[patricktoulon]

Bonjour mercatog

je l'attendait pas celle la !!!

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

[mercatog]

Allez Patrick, concoctez nous un bijou

[huître]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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é

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[huître]

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