Cara Membuat Login pada Excel dengan Banyak User
Langkah pembuatannya adalah :
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
Demikian tutorial untuk membuat Login Pada Excel dengan banyak User, semoga bermanfaat.
Yuk kepoin tips dan trik KelasMekanik lainnya di Google news