MACRO MEMBUAT FORM LOGIN DAN REGISTER ANGGOTA DI EXCEL

MACRO MEMBUAT FORM LOGIN DAN REGISTER ANGGOTA DI EXCEL

Mush-bro.co.cc - Sebagai tuntutan pekerjaan dikantor ,saya coba membuat makro excel, Form Login dan Register karyawan , prosesnya ketika file workbook dibuka, user diminta memasukkan nama dan password, apabila nama user belum ada di dalam data, maka user diharuskan mendaftarkan diri, status user sendiri ada dua pilihan, apakah sebagai admin atau hanya user saja.

Macro tersebut merupakan gabungan antara rumus di worksheet dan VBA Macro, untuk kode makronya mungkin terlalu panjang dan ruwet, jadi kalau ada yang ingin memberikan masukan code macro yang lebih singkat mush-bro terima dengan senang hati namanya juga sama-sama belajar.



Dibawah ini adalah kode VBAnya:

Private Sub UserForm_Activate()
Dim ws As Worksheet
ThisWorkbook.Application.Calculate
Set ws = Sheets("Password")
ws.Activate
ws.Range("A1:N50").Font.ColorIndex = 2
Range("B4").Select
LogNam.SetFocus
FrmDaf.Visible = False
End Sub

Private Sub Masuk_Click()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
ThisWorkbook.Application.Calculate
Set ws = Sheets("Password")
Set ws1 = Sheets("Admin")
Set ws2 = Sheets("User")
ws.Range("E4").Activate
ActiveCell.Value = LogNam.Value
ActiveCell.Offset(0, 1) = LogPwd.Value
LogNam.Value = ""
LogPwd.Value = ""
LogNam.SetFocus
If Range("I4").Value = True Then
MsgBox "Nama Anda " & Range("E4") & " dan anda adalah " & Range("J4").Value
Me.Hide
Else
MsgBox "Nama dan password salah... Jika belum memiliki username silahkan Daftar"
ws.Select
End If

If Range("J4").Value = "Admin" Then
ws1.Activate
ElseIf Range("J4").Value = "User" Then
ws2.Activate
Else
ws.Select
End If
LogNam.SetFocus
End Sub

Private Sub Daftar_Click()
FrmDaf.Visible = True
With Status
.AddItem "User"
.AddItem "Admin"
End With
End Sub

Private Sub Tambah_Click()
Dim Msg, Style, Title
Dim ws As Worksheet
ThisWorkbook.Application.Calculate
Set ws = Sheets("Password")
If DafNam.Value = "" Or DafPwd.Value = "" Or Status.Value = "" Then
MsgBox "Data harus diisi semua"
DafNam.Value = ""
DafPwd.Value = ""
Status.Value = ""
DafNam.SetFocus
Else
ws.Range("B4").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = DafNam.Value
ActiveCell.Offset(0, 1) = DafPwd.Value
ActiveCell.Offset(0, 2) = Status.Value
If Range("N4").Value > 1 Then
MsgBox "Data sudah ada coba cari yang lain"
Range("B4").End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).ClearContents
DafNam.Value = ""
DafPwd.Value = ""
Status.Value = ""
DafNam.SetFocus
Else
Msg = "Nama Anda : " & DafNam.Value & " ,Password : " & DafPwd.Value & " , Coba Login"
Style = vbOKCancel + vbDefaultButton1
Title = "Konfirmasi"
Response = MsgBox(Msg, Style, Title)
If Response = vbOK Then
ws.Range("B4").Select
FrmDaf.Visible = False
LogNam.SetFocus
Else
Range("B4").End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).ClearContents
DafNam.Value = ""
DafPwd.Value = ""
Status.Value = ""
DafNam.SetFocus
End If
End If
End If
ws.Range("B4").Select
End Sub

Private Sub FrmDaf_Layout()
DafNam.Value = ""
DafPwd.Value = ""
Status.Value = ""
DafNam.SetFocus
End Sub

Untuk rumus di worksheet sendiri, merupakan rumus standar yaitu menggunakan vlookup dan gabungan text, serta rumus lainnya...
Untuk mempelajari lebih jauh...saya sertakan file contoh bisa di DOWNLOAD disini