XL 2019 comment faire ouvert afficher menu vba

frederio

XLDnaute Impliqué
Bonjour à tous
Tu vous connais comment faire ?
Si tu veux être d’accord avec moi ??? vous m’aidez a expliqué comme Excel Merci
comment faire ouvert afficher menu vba
 

Pièces jointes

  • ouvert afficher menu vba.xlsm
    25 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
Bonsoir
je suppose que tu veux ton menu en haut a gauche
tout d'abords il faut affecter une macro a ta shape(ton bouton menu)
la sub affectée
VB:
Sub Image4_Cliquer()
UserForm1.Show
End Sub

ensuite il te faut une fonction pour determiner la position left et top en point de la grille
avec un ersatz de ma fonction perso pour positionner un form sur cell
dans le activate de ton userform
Code:
Private Sub UserForm_Activate()
    Dim Ptopx#
    With ActiveWindow.Panes(1)
        Ptopx = (.PointsToScreenPixelsX(72 / (.Parent.Zoom / 100)) - .PointsToScreenPixelsX(0)) / 72
        Me.Move .PointsToScreenPixelsX(0) / Ptopx, .PointsToScreenPixelsY(0) / Ptopx
    End With
End Sub
et voilà le tour est joué ton menu s'affiche en haut à gauche
demo.gif


j'en ai profiter pour faire une sub general pour le color hover
VB:
Private Sub UserForm_Activate()
    Dim Ptopx#
    With ActiveWindow.Panes(1)
        Ptopx = (.PointsToScreenPixelsX(72 / (.Parent.Zoom / 100)) - .PointsToScreenPixelsX(0)) / 72
        Me.Move .PointsToScreenPixelsX(0) / Ptopx, .PointsToScreenPixelsY(0) / Ptopx
    End With
End Sub

Private Sub UserForm_Initialize()
    Dim a&
    For Each Obj In Me.Controls
        a = a + 1
        Obj.BackColor = RGB(255, 255, 255)
        Obj.Caption = Sheets(a).Name
    Next
End Sub

Private Sub commandbuttonl_click()
    Sheets(Me.CommandButton1.Caption).Select
End Sub
Private Sub commandbutton2_click()
    Sheets(Me.CommandButton2.Caption).Select
End Sub
Private Sub commandbutton3_click()
    Sheets(Me.CommandButton3.Caption).Select
End Sub
Private Sub commandbutton4_click()
    Sheets(Me.CommandButton4.Caption).Select
End Sub
Private Sub commandbutton5_click()
    Sheets(Me.CommandButton5.Caption).Select
End Sub

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ColorHover CommandButton1
End Sub
Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ColorHover CommandButton2
    End Sub
Private Sub CommandButton3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ColorHover CommandButton3
End Sub
Private Sub CommandButton4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ColorHover CommandButton4
End Sub
Private Sub CommandButton5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ColorHover CommandButton5
End Sub

Sub ColorHover(ctrl As Object)
Dim Obj As Object
For Each Obj In Me.Controls
        If Obj.Name <> ctrl.Name Then
            Obj.BackColor = RGB(255, 255, 255)
        End If
    Next
    ctrl.BackColor = RGB(15, 215, 15)
End Sub
;)
 

Pièces jointes

  • ouvert afficher menu vba.xlsm
    30 KB · Affichages: 8

Statistiques des forums

Discussions
312 108
Messages
2 085 380
Membres
102 876
dernier inscrit
BouteilleMan