Vba DEROULANT

[bonoo]

bonjour a tous

je souhaiterais remplacer dans ma page d acceuil , tout les boutons macros, qui me dirige sur plusieurs page de mon classeurs par un menu deroulant en VBA , pensez vous que ce soit possible ?
Quelqu un peut il me diriger sur un exemple ou un fil
merci d avance

bono

 

[@+Thierry]

Salut Bonoo, (et la bande !! lol), et le Forum

Oui c'est assez simple à faire.

1) Dessiner une ListBox ActiveX de la barre d'Outils "Contrôles" (NB pas la barre d'outils formulaire)

2) Puis dans le Private de la WorkSheet en Question mettre ces quelques lignes de Codes :

Option Explicit
Private Sub Worksheet_Activate()
Dim WS As Worksheet
Me.ListBox1.Clear
For Each WS In Worksheets
Me.ListBox1.AddItem WS.Name
Next
End Sub

Private Sub ListBox1_Click()
Dim WsName As String
WsName = Me.ListBox1
Worksheets(WsName).Activate
End Sub

Ici l'action et le changement de Feuille quand on "Activate" la feuille en question. On peut choisir un autre évènement... Par Exemple WorkBook_Open en changeant le "Me" par le nom de la feuille...

Bon Aprèm
@+Thierry

 

[bonoo]

merci Thierry , c est clair et net je vais faire cela de suite, bon apres midi
chao

 

[m.lecxe]

a suivre une macro que tu doit affecrer a un bouton et qui te donne la liste des classeurs ouverts ainsi que les listes des feuilles de ces classeurs

Sub CreateMenu()
'Chip Pearson
Dim wb As Workbook
Dim WS As Worksheet
'Const cTag = "__TempTag__"

If Not Application.CommandBars.FindControl(Tag:=cTag) Is Nothing Then Application.CommandBars.FindControl(Tag:=cTag).Delete

With Application.CommandBars("Perso1").Controls.Add(Type:=msoControlPopup, Temporary:=True)
.Caption = "Feuilles"
.Tag = cTag
For Each wb In Workbooks
If wb.Windows(1).Visible = True Then GoTo a Else GoTo B
a:
With .Controls.Add(Type:=msoControlPopup) ', temporary:=True)
.Caption = wb.Name
.Visible = True
.OnAction = "CreateSheetsMenu_ActivateSheet" 'fs
.Tag = wb.Sheets(1).Range("A1").Address(True, True, xlA1, True) 'fs
For Each WS In wb.Worksheets
With .Controls.Add
.Caption = WS.Name
.OnAction = "'" & ThisWorkbook.Name & "'!ActivateSheet"
.Tag = WS.Range("A1").Address(True, True, xlA1, True)
End With
Next WS
End With
GoTo C
' Else
B:
With .Controls.Add(Type:=msoControlPopup) ', temporary:=True)
.Caption = wb.Name
.Visible = True
.Enabled = False
End With
' End If
C:
Next wb
End With

End Sub

Sub DeleteSheetsMenu()
If Not Application.CommandBars.FindControl(Tag:=cTag) Is Nothing Then _
Application.CommandBars.FindControl(Tag:=cTag).Delete
End Sub

Sub ActivateSheet()
'Chip
Dim Rng As Range
On Error Resume Next
Err.Number = 0
Set Rng = Range(Application.CommandBars.ActionControl.Tag)
If Err.Number <> 0 Then
Dim MAJ
MAJ = MsgBox("Erreur " & Err.Number & " " & Err.Description & vbLf & _
"Le classeur n'est pas ouvert ou la feuille n'existe pas." & vbLf & _
vbLf & "Voulez-vous mettre à jour ce menu?", 4, "")
If MAJ = vbYes Then Application.Run "'Classeur de macros personnelles'!CreateMenu"
CommandBars("Workbook tabs").ShowPopup 'Jim Rech posting
Exit Sub
End If
Rng.Parent.Parent.Activate
Rng.Parent.Select
End Sub

Sub CreateSheetsMenu_ActivateSheet()
'D Mc R
Dim Rng As Range
On Error Resume Next
Err.Number = 0
Set Rng = Range(Application.CommandBars.ActionControl.Tag)
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description & Chr(10) & _
"* 1004 The workbook is not open or does not match menu" & Chr(10) & _
"Rerun the CreateSheetsMenu with desired WorkBooks open"
CommandBars("Workbook tabs").ShowPopup 'Jim Rech posting
Exit Sub
End If
Rng.Parent.Parent.Activate
Rng.Parent.Select
End Sub

 

[bonoo]

merci bien pour ta reponse que je n avais pas encore vu .
merci