contoh kode-kode makro visual basic pada excel

KODE-KODE MAKRO

1.      Pada Workbook

a.       Membuat form login

Option Explicit
Dim sh As Object
Dim ws As Worksheet
Dim isi As Long
Dim Msg, Style, Title, Help, Ctxt, Response, MyString

'Properties ketika Userform aktif
Private Sub UserForm_Activate()
    ThisWorkbook.Application.Calculate
    ThisWorkbook.Sheets("Login").Visible = True
   
 'Hanya sheet Login yang tampil
    For Each sh In ThisWorkbook.Worksheets
        If Not sh.Name = "Login" Then sh.Visible = xlSheetHidden
    Next sh
    FrmLog.Visible = True
    LogNam.SetFocus
    FrmDaf.Visible = False
    Daftar.Visible = True
    Login.Visible = False
Set sh = Nothing
End Sub
Private Sub Masuk_Click()
ThisWorkbook.Application.Calculate
Set ws = Sheets("Password")

ws.Range("E4") = LogNam.Value
ws.Range("F4") = LogPwd.Value
 
LogNam.Value = ""
LogPwd.Value = ""
LogNam.SetFocus
  
'Kondisi jika cell I4, sheet password bernilai true, maka bisa masuk login
If ws.Range("I4").Value = True Then
    Msg = "Nama Anda : " & ws.Range("E4").Value & " ,Password : " & ws.Range("J4").Value
    Style = vbOKCancel + vbDefaultButton1
    Title = "Konfirmasi"
    Response = MsgBox(Msg, Style, Title)
    If Response = vbOK Then
 'Kondisi jika cell j4, sheet password, nilainya "Admin" maka hanya sheet admin yg ditampilkan
        If ws.Range("J4").Value = "Admin" Then
            ThisWorkbook.Sheets("Admin").Visible = True
            For Each sh In ThisWorkbook.Worksheets
                If Not sh.Name = "Admin" Then sh.Visible = xlSheetHidden
            Next sh
            Me.Hide
        Else
  'Selain itu sheet user yang tampil
            ThisWorkbook.Sheets("User").Visible = True
            For Each sh In ThisWorkbook.Worksheets
                If Not sh.Name = "User" Then sh.Visible = xlSheetHidden
            Next sh
            Me.Hide
        End If
    End If
Else
'Jika login salah maka akan muncul pesan dibawah ini
MsgBox "Nama Ama password salah... Kalau belum termasuk Anggota silahkan Daftar"
End If
Set ws = Nothing
Set Response = Nothing
End Sub
Private Sub Daftar_Click()
'Kondisi jika melakukan pendaftarn maka fram Login tidak tampil
FrmDaf.Visible = True
FrmLog.Visible = False
    With Status
        .AddItem "User"
        .AddItem "Admin"
    End With
Login.Visible = True
Daftar.Visible = False
End Sub
Private Sub Login_Click()
FrmLog.Visible = True
FrmDaf.Visible = False
Daftar.Visible = True
Login.Visible = False
End Sub

Private Sub Tambah_Click()
ThisWorkbook.Application.Calculate
Set ws = Sheets("Password")
'Mencari cell di kolom B yang kosong
isi = ws.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row

'Kondisi jika form pendaftaran kosong akan muncul message
If DafNam.Value = "" Or DafPwd.Value = "" Or Status.Value = "" Then
    MsgBox "Data harus diisi semua"
    DafNam.Value = ""
    DafPwd.Value = ""
    Status.Value = ""
    DafNam.SetFocus
Else
  'Kalau form tidak kosong maka datanya akan di masukkan ke cell di kolom B, C, D yang kosong
    ws.Cells(isi, 2).Value = DafNam.Value
    ws.Cells(isi, 3).Value = DafPwd.Value
    ws.Cells(isi, 4).Value = Status.Value

    'Untuk menghindari supaya tidak ada data user dan password yang sama
    If ws.Range("N4").Value > 1 Then
        MsgBox "Data sudah ada coba cari yang lain"
        ws.Range(ws.Cells(isi, 2), ws.Cells(isi, 4)).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
                FrmDaf.Visible = False
                FrmLog.Visible = True
                LogNam.SetFocus
    Else
         ws.Range(ws.Cells(isi, 2), ws.Cells(isi, 4)).ClearContents
                DafNam.Value = ""
                DafPwd.Value = ""
                Status.Value = ""
                DafNam.SetFocus
        End If
    End If
End If
Set ws = Nothing
End Sub

Private Sub FrmDaf_Layout()
    DafNam.Value = ""
    DafPwd.Value = ""
    Status.Value = ""
End Sub
'Kondisi untuk menonaktifkan icon Close "X"
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
        MsgBox "Maaf ya... harus login dulu"
    End If
End Sub

b.      untuk mengembalikan ke proses Login Kembali.

Option Explicit
Dim sh As Object

Sub AutoShape1_Click()
ThisWorkbook.Sheets("Login").Visible = True
   'hanya sheet Login yang tampil
    For Each sh In ThisWorkbook.Worksheets
        If Not sh.Name = "Login" Then sh.Visible = xlSheetHidden
    Next sh
UserForm1.Show
End Sub

2.      Pada Worksheet

a.       Menuju Sheet tertentu

Untuk menuju Sheet terdepan (nomor 1)

Sheets(1).Select

Atau

Sheet1.Select

Untuk menuju Sheet bernama “Try”

Sheet(“Try”).Select

b.      Memilih Sheet lebih dari 1

Sub pilihbyksheet()
Worksheets(Array(“Sheet1″, “Sheet2″, “Sheet3″)).Select
End Sub

 

3.      Pada Range Sel / Sel

a.       Menghapus Nama-Nama Range

Sub hapus_nama_range( )

Dim NameX As Name

For Each NameX In Names

ActiveWorkbook.Names(NameX.Name).Delete

Next NameX

End Sub

b.      Menyisipkan Baris dan Kolom

Kode berikut akan menyisipkan baris diatas range A1,

Range(“A1”).Select

Selection.EntireRow.Insert

Sedang yang berikut akan menyisipkan satu kolom disamping kiri range A1,

Range(“A1”).Select

Selection.EntireColumn.Insert