Discussion :

[raymoundo]

Bonjour,

Mon but est de créer un menu exactement comme le menu demarrer de windows mais je ne sais pas comment faire.


Je m'explique un peu plus. Je voudrais qu'en cliquant sur une cellule, cela ouvre à coté une liste ( comme quand on clique sur programmes dans le menu demarrer) et qu'ensuite si l'on clique sur un élément de la liste grâce à un lien hypertexte ca ouvre le fichier.

C'est possible?

Merci d'avance.

[SilkyRoad]

bonjour


Dans le module objet du classeur (ThisWorkbook):

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
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
 
'Création de la barre d'outils lors de l'ouverture du classeur
Private Sub Workbook_Open()
    Dim Barre As CommandBar
 
    Set Barre = Application.CommandBars.Add("MenuPerso", msoBarPopup, False, True)
 
    With Barre.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "Menu 01"
        .FaceId = 50
        .Tag = "C:\dossier\fichier01.xls"
        .OnAction = "NomMacro"
    End With
 
    With Barre.Controls.Add(msoControlButton, 2, , , True)
        .Caption = "Menu 02"
        .FaceId = 49
        .Tag = "C:\dossier\fichier02.xls"
        .OnAction = "NomMacro"
    End With
End Sub
 
 
 
'Supprime la barre d'outils lors de la fermeture du classeur
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    CommandBars("MenuPerso").Delete
End Sub

Dans le module objet de la feuille ou tu vas sélectionner tes cellules :

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim XY As POINTAPI
 
    GetCursorPos XY
    Application.CommandBars("MenuPerso").ShowPopup XY.x, XY.y
End Sub

Dans un module standard :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
 
Public Declare Function GetCursorPos Lib "user32" _
              (lpPoint As POINTAPI) As Long
 
Public Type POINTAPI
  x As Long
  y As Long
End Type
 
 
Sub NomMacro()
    ThisWorkbook.FollowHyperlink CommandBars.ActionControl.Tag
End Sub

bonne soirée
michel