Image sur sous menus commandbars

Le
Caroual
Bonjour,
Je continue ma création de menu dans la commandbars.
J'ai fait une liste dans une feuille et mes menus se créent à l'ouverture de
mon fichier perso.
Je n'arrive pas à créer une image sur le sous menu.
Est-ce qu'on ne peut créer des images que sur les commandes et pas les sous
menus ?
Merci
Caroual

Sub créationMenu()
Dim Nouv_Menu As CommandBarPopup
Dim sous_menu As CommandBarControl
Dim sous_sous_menu As CommandBarControl
Dim commande As CommandBarButton
Application.ScreenUpdating = False
Columns("a:a").Find("M1").Select
While ActiveCell <> ""
Select Case Left(UCase(ActiveCell), 1)
Case "M"
With Application.CommandBars(1)
Set Nouv_Menu = .Controls.Add(Type:=msoControlPopup, _
before:=.Controls("Fenêtre").Index, Temporary:=True)
End With
menu_ = ActiveCell
Nouv_Menu.Caption = ActiveCell.Offset(, 2)

Case "S" 'Creation des sous-menus
With Application.CommandBars(1)
Set sous_menu = Nouv_Menu.Controls.Add(Type:=msoControlPopup)
End With
sous_menu.Caption = ActiveCell.Offset(, 2)

ICI EST MON PROBLEME
' image_bouton = "Image " & ActiveCell.Offset(, 6)
' ActiveSheet.Shapes(image_bouton).Copy
'With sous_menu
' .Style = msoControlPopup
' If ActiveCell.Offset(, 6) <> "" Then .PasteFace Else .FaceId = 0
'End With
etc..
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19749021
Bonjour Caroual,

Un petit exemple vite fait ...

Dans l'exemple : L'image porte le nom de "Denis"

Tout est dans 'msoControlPopup OU msoControlButton

Si tu définis le contrôle du sous-menu avec "MsoControlButton"
tu pourras ajouter une image mais tu n'auras pas la capacité
d'ajouter un sous-menu deuxième niveau à ce sous-menu

Si tu définis le contrôle du sous-menu avec "msoControlPopup"
tu n'auras pas droit à l'image mais tu pourras ajouter un sous-souss-menu.
à toi de choisir.

'----------------------------------------------
Sub créationMenu()
Dim Nouv_Menu As CommandBarPopup
Dim sous_menu As CommandBarControl
Dim sous_sous_menu As CommandBarControl
Dim commande As CommandBarButton

With Application.CommandBars(1)
Set Nouv_Menu = .Controls.Add(Type:=msoControlPopup, _
before:=.Controls("Fenêtre").Index, Temporary:=True)
End With
Nouv_Menu.Caption = "toto"

'Ajouter un premier sous-menu à toto:
'msoControlPopup ou msoControlButton
With Application.CommandBars(1)
Set sous_menu = Nouv_Menu.Controls.Add(Type:=msoControlButton)
End With
sous_menu.Caption = "Caroual"

'Coller l'image "Denis" dans le presse-papier
With Worksheets("Feuil1")
With .Shapes("Denis")
.Copy
End With
End With

With sous_menu
.Caption = "Macro1"
'Affiche Icône et Texte
.Style = msoButtonIconAndCaption
.PasteFace
End With
End Sub
'----------------------------------------------
Caroual
Le #19749451
OK, je te remercie, je suis un peu étonnée car il semble y avoir le petit
carré qui attend son image. J'ai besoin des sous sous menus donc il n'y aura
pas d'image.
Pour mes msocontrolButton j'ai une image dans une cellule et je mets le
numéro de l'image dans la cellule à coté.
Serait-il possible que le numéro se reporte tout seul avec une fonction qui
dirait = le numéro de l'image de la cellule à droite de l'image.
Encore merci
Caroual

"MichDenis"
Bonjour Caroual,

Un petit exemple vite fait ...

Dans l'exemple : L'image porte le nom de "Denis"

Tout est dans 'msoControlPopup OU msoControlButton

Si tu définis le contrôle du sous-menu avec "MsoControlButton"
tu pourras ajouter une image mais tu n'auras pas la capacité
d'ajouter un sous-menu deuxième niveau à ce sous-menu

Si tu définis le contrôle du sous-menu avec "msoControlPopup"
tu n'auras pas droit à l'image mais tu pourras ajouter un sous-souss-menu.
à toi de choisir.

'----------------------------------------------
Sub créationMenu()
Dim Nouv_Menu As CommandBarPopup
Dim sous_menu As CommandBarControl
Dim sous_sous_menu As CommandBarControl
Dim commande As CommandBarButton

With Application.CommandBars(1)
Set Nouv_Menu = .Controls.Add(Type:=msoControlPopup, _
before:=.Controls("Fenêtre").Index, Temporary:=True)
End With
Nouv_Menu.Caption = "toto"

'Ajouter un premier sous-menu à toto:
'msoControlPopup ou msoControlButton
With Application.CommandBars(1)
Set sous_menu = Nouv_Menu.Controls.Add(Type:=msoControlButton)
End With
sous_menu.Caption = "Caroual"

'Coller l'image "Denis" dans le presse-papier
With Worksheets("Feuil1")
With .Shapes("Denis")
.Copy
End With
End With

With sous_menu
.Caption = "Macro1"
'Affiche Icône et Texte
.Style = msoButtonIconAndCaption
.PasteFace
End With
End Sub
'----------------------------------------------







MichDenis
Le #19749541
Je n'ai pas vraiment compris...

Lorsque tu insères une image dans une cellule, Excel par défaut
nomme cette image "Image " et ajoute un index : "Image 1"
Tu peux voir son nom dans la section à l'extrême gauche de
la barre des formules.
Cependant en VBA, Excel parle anglais... et la même image porte
le nom de "Picture 1". Cependant si tu renommes la racine du
nom de l'image d'un expression perso. , l'image conserve son
nom au niveau de la feuille et du code VBA.

En supposant que ton numéro de l'image est dans la cellule A1
et que tu as conservé la racine "Image " comme nom de tes images.

with Worksheets("Feuil1")
SonNom = .Shapes("Picture " & .Range("A1").value)
.Shapes(SonNom).copy
End with

"Caroual"
OK, je te remercie, je suis un peu étonnée car il semble y avoir le petit
carré qui attend son image. J'ai besoin des sous sous menus donc il n'y aura
pas d'image.
Pour mes msocontrolButton j'ai une image dans une cellule et je mets le
numéro de l'image dans la cellule à coté.
Serait-il possible que le numéro se reporte tout seul avec une fonction qui
dirait = le numéro de l'image de la cellule à droite de l'image.
Encore merci
Caroual

"MichDenis"
Bonjour Caroual,

Un petit exemple vite fait ...

Dans l'exemple : L'image porte le nom de "Denis"

Tout est dans 'msoControlPopup OU msoControlButton

Si tu définis le contrôle du sous-menu avec "MsoControlButton"
tu pourras ajouter une image mais tu n'auras pas la capacité
d'ajouter un sous-menu deuxième niveau à ce sous-menu

Si tu définis le contrôle du sous-menu avec "msoControlPopup"
tu n'auras pas droit à l'image mais tu pourras ajouter un sous-souss-menu.
à toi de choisir.

'----------------------------------------------
Sub créationMenu()
Dim Nouv_Menu As CommandBarPopup
Dim sous_menu As CommandBarControl
Dim sous_sous_menu As CommandBarControl
Dim commande As CommandBarButton

With Application.CommandBars(1)
Set Nouv_Menu = .Controls.Add(Type:=msoControlPopup, _
before:=.Controls("Fenêtre").Index, Temporary:=True)
End With
Nouv_Menu.Caption = "toto"

'Ajouter un premier sous-menu à toto:
'msoControlPopup ou msoControlButton
With Application.CommandBars(1)
Set sous_menu = Nouv_Menu.Controls.Add(Type:=msoControlButton)
End With
sous_menu.Caption = "Caroual"

'Coller l'image "Denis" dans le presse-papier
With Worksheets("Feuil1")
With .Shapes("Denis")
.Copy
End With
End With

With sous_menu
.Caption = "Macro1"
'Affiche Icône et Texte
.Style = msoButtonIconAndCaption
.PasteFace
End With
End Sub
'----------------------------------------------







Caroual
Le #19749601
J'ai une liste dans une feuille excel avec le nom de mes menus sous menus
etc...
Pour chaque commande j'ai choisi un bouton que je mets dans une cellule a
coté de ma commande et le numéro de l'image encore dans la cellule à coté.
Ma macro balaye toutes les lignes et trouve le nom de la commande, le nom de
la macro, le numéro de l'image et crée mes menus perso.
J'avais préparé tout cela dans un classeur et je viens de copier cette
feuille dans mon classeur de macro perso. seulement les images ont changé de
numéro.
C'est pour cela que j'imaginais que j'aurais pu mettre une fonction qui
reconnaisse le numéro de l'image de la cellule à coté. cela m'évitait de
sélectionner chaque image pour retrouver son numéro.

Caroual

"MichDenis"
Je n'ai pas vraiment compris...

Lorsque tu insères une image dans une cellule, Excel par défaut
nomme cette image "Image " et ajoute un index : "Image 1"
Tu peux voir son nom dans la section à l'extrême gauche de
la barre des formules.
Cependant en VBA, Excel parle anglais... et la même image porte
le nom de "Picture 1". Cependant si tu renommes la racine du
nom de l'image d'un expression perso. , l'image conserve son
nom au niveau de la feuille et du code VBA.

En supposant que ton numéro de l'image est dans la cellule A1
et que tu as conservé la racine "Image " comme nom de tes images.

with Worksheets("Feuil1")
SonNom = .Shapes("Picture " & .Range("A1").value)
.Shapes(SonNom).copy
End with

"Caroual" discussion :

OK, je te remercie, je suis un peu étonnée car il semble y avoir le petit
carré qui attend son image. J'ai besoin des sous sous menus donc il n'y
aura
pas d'image.
Pour mes msocontrolButton j'ai une image dans une cellule et je mets le
numéro de l'image dans la cellule à coté.
Serait-il possible que le numéro se reporte tout seul avec une fonction
qui
dirait = le numéro de l'image de la cellule à droite de l'image.
Encore merci
Caroual

"MichDenis"
Bonjour Caroual,

Un petit exemple vite fait ...

Dans l'exemple : L'image porte le nom de "Denis"

Tout est dans 'msoControlPopup OU msoControlButton

Si tu définis le contrôle du sous-menu avec "MsoControlButton"
tu pourras ajouter une image mais tu n'auras pas la capacité
d'ajouter un sous-menu deuxième niveau à ce sous-menu

Si tu définis le contrôle du sous-menu avec "msoControlPopup"
tu n'auras pas droit à l'image mais tu pourras ajouter un
sous-souss-menu.
à toi de choisir.

'----------------------------------------------
Sub créationMenu()
Dim Nouv_Menu As CommandBarPopup
Dim sous_menu As CommandBarControl
Dim sous_sous_menu As CommandBarControl
Dim commande As CommandBarButton

With Application.CommandBars(1)
Set Nouv_Menu = .Controls.Add(Type:=msoControlPopup, _
before:=.Controls("Fenêtre").Index, Temporary:=True)
End With
Nouv_Menu.Caption = "toto"

'Ajouter un premier sous-menu à toto:
'msoControlPopup ou msoControlButton
With Application.CommandBars(1)
Set sous_menu = Nouv_Menu.Controls.Add(Type:=msoControlButton)
End With
sous_menu.Caption = "Caroual"

'Coller l'image "Denis" dans le presse-papier
With Worksheets("Feuil1")
With .Shapes("Denis")
.Copy
End With
End With

With sous_menu
.Caption = "Macro1"
'Affiche Icône et Texte
.Style = msoButtonIconAndCaption
.PasteFace
End With
End Sub
'----------------------------------------------










MichDenis
Le #19749911
Tu peux utiliser ceci :

Dans la "Feuil1", j'ai mis une image dans la cellule B4
La procédure, il y a une boucle qui teste si il y a une
image dans la cellule à côté de la cellule A4
si oui, tu obtiens son nom dans la variable "SonNom"

2 façons de faire :

Sub test()
Dim Sh As Shape, SonNom As String

With Worksheets("Feuil1")
For Each Sh In .Shapes
If Sh.TopLeftCell.Address = _
.Range("A4").Offset(, 1).Address Then
sonNom = Sh.Name
End If
Next
End With
Shapes(sonNom).Copy
End Sub

Tu peux écrire une petite fonction comme ceci pour extraire le
nom de l'image dans une présumée cellule :
'--------------------------------------
Sub test()
Dim SonNom As String

With Worksheets("Feuil1")
'appel de la fonction
'Extraire le nom de l'image en B4 si elle existe
SonNom = NomImage(.Range("A4").Offset(, 1))
End With
If SonNom <>"" then
Shapes(SonNom).Copy
End if
End Sub
'--------------------------------------
Function NomImage(Cellule As Range)
Dim Sh As Shape
With Worksheets(Cellule.Parent.Name)
For Each Sh In .Shapes
If Sh.TopLeftCell.Address = _
Cellule.Address Then
SonNom = Sh.Name
End If
Next
End With
NomImage = SonNom
End Function
'--------------------------------------
Caroual
Le #19750081
C'est parfait une fois de plus, vous êtes trop fort et très sympa.
J'ai utilisé la fonction et elle convient parfaitement.
A bientôt car j'ai toujours des problèmes à résoudre.
Caroual


"MichDenis"
Tu peux utiliser ceci :

Dans la "Feuil1", j'ai mis une image dans la cellule B4
La procédure, il y a une boucle qui teste si il y a une
image dans la cellule à côté de la cellule A4
si oui, tu obtiens son nom dans la variable "SonNom"

2 façons de faire :

Sub test()
Dim Sh As Shape, SonNom As String

With Worksheets("Feuil1")
For Each Sh In .Shapes
If Sh.TopLeftCell.Address = _
.Range("A4").Offset(, 1).Address Then
sonNom = Sh.Name
End If
Next
End With
Shapes(sonNom).Copy
End Sub

Tu peux écrire une petite fonction comme ceci pour extraire le
nom de l'image dans une présumée cellule :
'--------------------------------------
Sub test()
Dim SonNom As String

With Worksheets("Feuil1")
'appel de la fonction
'Extraire le nom de l'image en B4 si elle existe
SonNom = NomImage(.Range("A4").Offset(, 1))
End With
If SonNom <>"" then
Shapes(SonNom).Copy
End if
End Sub
'--------------------------------------
Function NomImage(Cellule As Range)
Dim Sh As Shape
With Worksheets(Cellule.Parent.Name)
For Each Sh In .Shapes
If Sh.TopLeftCell.Address = _
Cellule.Address Then
SonNom = Sh.Name
End If
Next
End With
NomImage = SonNom
End Function
'--------------------------------------



MichDenis
Le #19750531
Seulement modifier un tantinet les 2 procédures...

'--------------------------------------
Sub test()
Dim SonNom As String
With Worksheets("Feuil1")
'appel de la fonction
'Extraire le nom de l'image en B4 si elle existe
SonNom = NomImage(.Range("A4").Offset(, 1))
If SonNom <>"" then
.Shapes(SonNom).Copy
End if
End With
End Sub
'--------------------------------------
Function NomImage(Cellule As Range)
Dim Sh As Shape
With Worksheets(Cellule.Parent.Name)
For Each Sh In .Shapes
If Sh.TopLeftCell.Address = _
Cellule.Address Then
SonNom = Sh.Name
Exit For
End If
Next
End With
NomImage = SonNom
End Function
'--------------------------------------
Caroual
Le #19753961
Merci
J'ai vu les modifs de la sub, je n'utilise que la fonction et elle est OK.
Caroual

"MichDenis"
Seulement modifier un tantinet les 2 procédures...

'--------------------------------------
Sub test()
Dim SonNom As String
With Worksheets("Feuil1")
'appel de la fonction
'Extraire le nom de l'image en B4 si elle existe
SonNom = NomImage(.Range("A4").Offset(, 1))
If SonNom <>"" then
.Shapes(SonNom).Copy
End if
End With
End Sub
'--------------------------------------
Function NomImage(Cellule As Range)
Dim Sh As Shape
With Worksheets(Cellule.Parent.Name)
For Each Sh In .Shapes
If Sh.TopLeftCell.Address = _
Cellule.Address Then
SonNom = Sh.Name
Exit For
End If
Next
End With
NomImage = SonNom
End Function
'--------------------------------------





MichDenis
Le #19754241
à la fonction, je n'ai ajouté que "Exit For" afin de terminer
la boucle dès que l'image est trouvé. L'objectif, maximiser
l'efficacité de la procédure.
Publicité
Poster une réponse
Anonyme