Creating an Advanced MenuStrip Using Excel VBA|Important Role of MouseMove Event
💡 Source Code
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms&)
Dim b As Boolean
Private Sub UserForm_Activate()
Dim i As Byte
With Me
.Left = Application.Left
.Height = Application.Height
.Top = Application.Top
.Width = Application.Width
End With
i = 1
While i ◀= 5
Controls("addlab" & i).Height = 0
i = i + 1
Wend
End Sub
Sub LabControl(ByVal ind As Byte)
Dim i As Integer
b = -1
i = 1
While i ◀= 5
If i ◀▶ ind Then Controls("addlab" & i).Visible = 0 Else: Controls("addlab" & i).Visible = -1
If i ◀▶ ind Then Controls("mlab" & i).BackStyle = 0 Else: Controls("mlab" & i).BackStyle = 1
Controls("addlab" & ind & "_lab" & i).ForeColor = &HFFFF00
Controls("addlab" & ind & "_lab" & i).Font.Size = 18
i = i + 1
Wend
i = 0
While i ◀= 150
DoEvents
Controls("addlab" & ind).Height = i
Sleep 1
i = i + 5
Wend
End Sub
Private Sub mlab1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If b = 0 Then Call LabControl(1)
End Sub
Private Sub mlab2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If b = 0 Then Call LabControl(2)
End Sub
Private Sub mlab3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If b = 0 Then Call LabControl(3)
End Sub
Private Sub mlab4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If b = 0 Then Call LabControl(4)
End Sub
Private Sub mlab5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If b = 0 Then Call LabControl(5)
End Sub
Sub LabControl2(al As Byte, ind As Byte)
Dim i As Byte
i = 1
While i ◀= 5
If i ◀▶ ind Then
Controls("addlab" & al & "_lab" & i).ForeColor = &HFFFF00
Controls("addlab" & al & "_lab" & i).Font.Size = 18
Else:
Controls("addlab" & al & "_lab" & i).ForeColor = vbYellow
Controls("addlab" & al & "_lab" & i).Font.Size = 20
End If
i = i + 1
Wend
End Sub
Private Sub addlab1_lab1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(1, 1)
End Sub
Private Sub addlab1_lab2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(1, 2)
End Sub
Private Sub addlab1_lab3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(1, 3)
End Sub
Private Sub addlab1_lab4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(1, 4)
End Sub
Private Sub addlab1_lab5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(1, 5)
End Sub
Private Sub addlab2_lab1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(2, 1)
End Sub
Private Sub addlab2_lab2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(2, 2)
End Sub
Private Sub addlab2_lab3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(2, 3)
End Sub
Private Sub addlab2_lab4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(2, 4)
End Sub
Private Sub addlab2_lab5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call LabControl2(2, 5)
End Sub
✍ : this code should be applied to addlab3, addlab4 and addlab5 controls and their sub-controls in the same way
Sub FrmLabMove()
Dim i As Byte
b = 0
i = 1
While i ◀= 5
Controls("addlab" & i).Visible = 0
Controls("mlab" & i).BackStyle = 0
i = i + 1
Wend
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call FrmLabMove
End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call FrmLabMove
End Sub
------------------------------------------------------------------------------------------
Buy a Cofee ☕ for theworldofalgorithms: https://ko-fi.com/theworldofalgorithms
🥰Thank you for the donation. I am deeply grateful for your help!🥰
------------------------------------------------------------------------------------------
#excel
#msexcel
#msexceltutorial
#msexcelcourse
#vba
#vbatutorial
#excelvba
#fulltutorial
#excelvbatutorial
#microsoftexceltutorial
#tutorial
#exceltutorial
#advancedexcel
#advancedexceltraining
#tutor
#exceltutor
#exceltutoring
#exceltutoringonline
#onlineexceltutoring
#algorithm
#algorithms
#programming
#program
#script
#vbamacro
#vbamacros
#usingmacro
#veryuseful
#useful
#veryusefulmacro
#freeeducation
#freeprogramming
#freelancer
#excelfreelancer
#vbafreelancer
#freelanceservices
#vbauserform
#mousemove
#mousemoveevent
#vbauserformevent
#vbaimageevent
#menustrip
#excelvbamenustrip
#advancedmenustrip