Excel VBA - Create a Star Rating System
💡 Source Code Private Sub UserForm_Activate() With Me .Height = Application.Height .Width = Application.Width .Left = Application.Left .Top = Application.Top End With Label7.Caption = "" End Sub Sub MouseMoveForStars(lbl As Byte) Dim i As Byte, k As Byte For i = 1 To 6 If i = lbl Then For k = 1 To i Controls("Label" & k).Caption = "G" Controls("Label" & k).ForeColor = vbYellow Next k Call LbTxt(i) Else: Controls("Label" & i).Caption = "H" Controls("Label" & i).ForeColor = vbBlue End If Next i End Sub Sub LbTxt(l_cap As Byte) Dim l_txt As String Select Case l_cap Case 1: l_txt = "Very bad" Case 2: l_txt = "Poor" Case 3: l_txt = "Fair" Case 4: l_txt = "Good" Case 5: l_txt = "Very good" Case Else: l_txt = "Excellent" End Select Label7.Caption = l_txt End Sub Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Call MouseMoveForStars(1) End Sub Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Call MouseMoveForStars(2) End Sub Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Call MouseMoveForStars(3) End Sub Private Sub Label4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Call MouseMoveForStars(4) End Sub Private Sub Label5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Call MouseMoveForStars(5) End Sub Private Sub Label6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Call MouseMoveForStars(6) End Sub ----------------------------------------------------------------------------------------------------------- #excel #msexcel #msexceltutorial #msexcelcourse #vba #vbatutorial #excelvba #excelvbatutorial #microsoftexceltutorial #tutorial #exceltutorial #excelvbatutorial #vbatutorial #advancedexcel #advancedexceltraining #algorithm #algorithms #programming #program #script #vbamacro #vbamacros #userform #loop #star #starrating #starratingsystem #system #rating #ratings #ratingsystem #mousemove #mousemoveevent #vbamousemoveevent #excelvbamousemoveevent #createaratingsystem
Download
0 formatsNo download links available.