Lompat ke konten Lompat ke sidebar Lompat ke footer

Excel - Login Form Multi User


Script VBA Excel



Berikit ini cara pembuatan Login Form Multi User pada Excel dengan pilihan otoritas menu pada saat login.

Berikut langkah pembuatannya.

1. Video tutorial

Karena ukuran video tutorial terlalu besar untuk di attach kan di web ini, maka kami lampirkan link untuk menuju vidio tersebut silahkan klik disini.

2. Template dan Script

Template dalam bentuk excel dan script dalam bentuk word bisa di download disini.



Untuk script juga bisa copy paste dibawah ini : 


'1. CODING USERFORM INITIALIZE

Private Sub UserForm_Initialize()
Me.MultiPage1.Value = 0
Me.Frame3.Height = Me.MultiPage1.Height
Me.Frame4.Height = Me.MultiPage1.Height

Me.ONOFF1.BackColor = RGB(219, 42, 89)
Me.ONOFF1.ForeColor = RGB(0, 0, 0)

Me.ONOFF2.BackColor = RGB(219, 42, 89)
Me.ONOFF2.ForeColor = RGB(0, 0, 0)

Me.ONOFF3.BackColor = RGB(219, 42, 89)
Me.ONOFF3.ForeColor = RGB(0, 0, 0)

Me.Line1.BackColor = RGB(56, 66, 66)
Me.Line2.BackColor = RGB(56, 66, 66)
Me.Line3.BackColor = RGB(56, 66, 66)

Me.TXTADMINPASSWORD.Visible = False
Me.CMDOK.Visible = False
Me.TXTCHECKPASSWORD.Visible = False

End Sub

'2. CODING TOMBOL SIGNUP
Private Sub CMDSIGNUP_Click()
Me.TXTADMINPASSWORD.Visible = True
Me.CMDOK.Visible = True
End Sub


'3. CODING TOMBOL OK (SIGNUP)

Private Sub CMDOK_Click()
If Me.TXTADMINPASSWORD.Value <> "kelasmekanik" Then
Call MsgBox("Maaf, Password Admin salah, silahkan hubungi Administrator", vbInformation, "Password Salah")
Me.TXTADMINPASSWORD.Value = ""
Me.TXTADMINPASSWORD.Visible = False
Me.CMDOK.Visible = False
Else
Me.TXTADMINPASSWORD.Value = ""
Me.TXTADMINPASSWORD.Visible = False
Me.CMDOK.Visible = False
Me.MultiPage1.Value = 1
End If
End Sub


'4.  CODING TOMBOL LOGIN1 PAGE2

Private Sub CMDLOGIN1_Click()
Me.MultiPage1.Value = 0
End Sub


'5.  CODING ANIMASI TOMBOL

Private Sub ButtonOn1()
Do While ONOFF1.Left < Me.Line1.Width - Me.ONOFF1.Width
ONOFF1.Left = ONOFF1.Left + 0.25
DoEvents
Me.ONOFF1.Caption = "Yes"
Me.ONOFF1.BackColor = RGB(0, 225, 0)
Me.ONOFF1.ForeColor = RGB(0, 0, 0)
Loop
End Sub

Private Sub ButtonOff1()
Do While ONOFF1.Left > 0
ONOFF1.Left = ONOFF1.Left - 0.25
DoEvents
Me.ONOFF1.Caption = "No"
Me.ONOFF1.BackColor = RGB(219, 42, 89)
Me.ONOFF1.ForeColor = RGB(0, 0, 0)
Me.Line1.BackColor = RGB(56, 66, 66)
Loop
End Sub

Private Sub ButtonOn2()
Do While ONOFF2.Left < Me.Line2.Width - Me.ONOFF2.Width
ONOFF2.Left = ONOFF2.Left + 0.25
DoEvents
Me.ONOFF2.Caption = "Yes"
Me.ONOFF2.BackColor = RGB(0, 225, 0)
Me.ONOFF2.ForeColor = RGB(0, 0, 0)
Loop
End Sub

Private Sub ButtonOff2()
Do While ONOFF2.Left > 0
ONOFF2.Left = ONOFF2.Left - 0.25
DoEvents
Me.ONOFF2.Caption = "No"
Me.ONOFF2.BackColor = RGB(219, 42, 89)
Me.ONOFF2.ForeColor = RGB(0, 0, 0)
Me.Line2.BackColor = RGB(56, 66, 66)
Loop
End Sub

Private Sub ButtonOn3()
Do While ONOFF3.Left < Me.Line3.Width - Me.ONOFF3.Width
ONOFF3.Left = ONOFF3.Left + 0.25
DoEvents
Me.ONOFF3.Caption = "Yes"
Me.ONOFF3.BackColor = RGB(0, 225, 0)
Me.ONOFF3.ForeColor = RGB(0, 0, 0)
Loop
End Sub

Private Sub ButtonOff3()
Do While ONOFF3.Left > 0
ONOFF3.Left = ONOFF3.Left - 0.25
DoEvents
Me.ONOFF3.Caption = "No"
Me.ONOFF3.BackColor = RGB(219, 42, 89)
Me.ONOFF3.ForeColor = RGB(0, 0, 0)
Me.Line3.BackColor = RGB(56, 66, 66)
Loop
End Sub

'6.  TOMBOL PERMISION LEVEL ( BUTTON 1 - 3)

Private Sub ONOFF1_Click()
If Me.ONOFF1.Caption = "No" Then
Call ButtonOn1
Else
Call ButtonOff1
End If
End Sub

Private Sub ONOFF2_Click()
If Me.ONOFF2.Caption = "No" Then
Call ButtonOn2
Else
Call ButtonOff2
End If
End Sub

Private Sub ONOFF3_Click()
If Me.ONOFF3.Caption = "No" Then
Call ButtonOn3
Else
Call ButtonOff3
End If
End Sub

'7.  CODING TOMBOL CREATE

Private Sub CMDCREATE_Click()
Dim DataUser As Object
Set DataUser = Sheet1.Range("A1000").End(xlUp)

Dim CariUser As Object
Set CariUser = Sheet1.Range("A2:A1000")

If Me.TXTUSERNAME.Value = "" Then
Call MsgBox("Harap isi User Name", vbInformation, "Data Akun")
Else

If WorksheetFunction.CountIf(CariUser, Me.TXTUSERNAME.Value) > 0 Then
Call MsgBox("User ini sudah terdaftar", vbInformation, "Data Akun")
Else

If Me.TXTUSERNAME.Value = "" _
Or Me.TXTEMAIL.Value = "" _
Or Me.TXTPHONE.Value = "" _
Or Me.TXTNEWPASSWORD.Value = "" Then
Call MsgBox("Harap isi data akun dengan lengkap", vbInformation, "Data Akun")
Else

If Me.TXTNEWPASSWORD.Value <> Me.TXTCONFIRMPASSWORD.Value Then
Call MsgBox("Password tidak sama", vbInformation, "Data Akun")
Else

DataUser.Offset(1, 0).Value = Me.TXTUSERNAME.Value
DataUser.Offset(1, 1).Value = Me.TXTEMAIL.Value
DataUser.Offset(1, 2).Value = Me.TXTPHONE.Value
DataUser.Offset(1, 3).Value = Me.TXTNEWPASSWORD.Value

If Me.ONOFF1.Caption = "Yes" Then
DataUser.Offset(1, 4).Value = True
End If
If Me.ONOFF1.Caption = "No" Then
DataUser.Offset(1, 4).Value = False
End If

If Me.ONOFF2.Caption = "Yes" Then
DataUser.Offset(1, 5).Value = True
End If
If Me.ONOFF2.Caption = "No" Then
DataUser.Offset(1, 5).Value = False
End If

If Me.ONOFF3.Caption = "Yes" Then
DataUser.Offset(1, 6).Value = True
End If
If Me.ONOFF3.Caption = "No" Then
DataUser.Offset(1, 6).Value = False
End If

Call MsgBox("User berhasil di tambah", vbInformation, "Tambah User")
Me.TXTUSERNAME.Value = ""
Me.TXTEMAIL.Value = ""
Me.TXTPHONE.Value = ""
Me.TXTNEWPASSWORD.Value = ""
Me.TXTCONFIRMPASSWORD.Value = ""
Call ButtonOff1
Call ButtonOff2
Call ButtonOff3
Me.MultiPage1.Value = 0
End If
End If
End If
End If
End Sub

'8.  CODING TOMBOL LOGIN PAGE 1

Private Sub CMDLOGIN_Click()
On Error GoTo Salah
Set CariUser = Sheet1.Range("A2:A100").Find(What:=Me.TXTUSER.Value, LookAt:=xlWhole)
Me.TXTCHECKPASSWORD.Value = CariUser.Offset(0, 3).Value
If Me.TXTUSER.Value = "" Then
Call MsgBox("Username tidak terdaftar", vbInformation, "User Account")
Else

If Me.TXTUSER.Value = "" _
Or Me.TXTPASSWORD.Value = "" _
Or Me.TXTPASSWORD.Value <> Me.TXTCHECKPASSWORD.Value Then
Call MsgBox("Password salah", vbInformation, "Login Error")
Else

Call Permission
Unload Me
UserForm2.LBUSER.Caption = Me.TXTUSER.Value
UserForm2.Show
End If
End If

Exit Sub
Salah:
Call MsgBox("Username tidak terdaftar", vbInformation, "User Account")
End Sub

'9.  CODING PERMISION UNTUK TOMBOL PADA FORM MENU

Private Sub Permission()
Set CariUser = Sheet1.Range("A2:A100").Find(What:=Me.TXTUSER.Value, LookAt:=xlWhole)
If CariUser.Offset(0, 4).Value = False Then
UserForm2.CMDFINDDATA.Enabled = False
Else
UserForm2.CMDFINDDATA.Enabled = True
End If

If CariUser.Offset(0, 5).Value = False Then
UserForm2.CMDDATA.Enabled = False
Else
UserForm2.CMDDATA.Enabled = True
End If

If CariUser.Offset(0, 6).Value = False Then
UserForm2.CMDLISTUSER.Enabled = False
Else
UserForm2.CMDLISTUSER.Enabled = True
End If

End Sub

'10. Membuat tombol exit

Private Sub CMDexit_Click()
Select Case MsgBox("Anda akan keluar dari Aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbCritical Or vbDefaultButton1, "Keluar Aplikasi")
Case vbNo
Exit Sub
Case vbYes
End Select
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

'11. Non Aktif tanda X'

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Call MsgBox("Silahkan klik EXIT", vbCritical, "Exit")
Cancel = True
End If
End Sub