Salah Satu cara terbaik untuk mempelajari Macro Excel adalah dengan melihat kode macro itu sendiri dan mencoba nya. dengan demikian kita tahu yang bisa di lakukan oleh macro.Dan kemudian di sesuaikan dengan kebutuhan kita.
Apabila kita tidak menemukan kode macro yang sesuai yang kita butuhkan,cara alternative nya adalah dengan menggunakan fasilitas record macro.
Kode di bawah adalah sebagian yang bisa di jadikan referensi
Auto Run
untuk menjalankan macro secara otomatis saat work book di buka
Sub Auto_Open()
Msgbox "Hello"
End Sub
code di atas di letakan di modul , bisa juga di letakan di workbook, code di bawah ini,,
Private Sub Workbook_Open()
Msgbox "Hello"
End Sub
Active Cell
adalah untuk memilih cell yang sedang aktif, ini berguna jika kita ingin pindah cell ke cell yang lain
Adding Items to a combobox
menambahkan list ke dalam combo box pakai code di bawah [ note:unutk menambhakan list bisa juga dari range di spread sheet]
ComboBox1.AddItem "Product A"
ComboBox1.AddItem "Product B"
Counting Rows & Columns & Sheets
Terkadang ketika memilih range kita ingin tahu berapa jumlah rows atau pun kolom yg telah di plih.
Sub Count()
myCount = Selection.Rows.Count 'Ganti Rows ke kolom jika ingin menghitung kolom
MsgBox myCount
End Sub
macro di bawah untuk menghitung jumlah sheet yang ada di workbook
Sub Count2()
myCount = Application.Sheets.Count
MsgBox myCount
End Sub
Carriage Return
untuk membuat message box menjadi 2 baris atau lebih
Sub duabaris()
MsgBox "Line 1" & vbCrLf & "Line 2"
End Sub
Close All Files
terkadang kita ingin menutup semua file tanpa di save ,melakukan secara manual akan sangat tidak efisien karena setiap close selalu di tanya "Do you wanna save?"
Sub CloseAll()
Application.DisplayAlerts = False
myTotal = Workbooks.Count
For i = 1 To myTotal
ActiveWorkbook.Close
Next i
End Sub
Copying A Range
copy data dari range bisa di lakukan dengan macro,macro di bawah untuk copy dari range A1:A3 ke active cell , sheet yang sama.
Sub CopyRange()
Range("A1:A3").Copy Destination:=ActiveCell
End Sub
untuk copy dari range sheet yang berbeda ke active cell
Sheets("sheet3").Range("A1:A3").Copy Destination:=ActiveCell
Counter
untuk menggunakan counter di dalam macro, hanya menunjuk sembarang cell utk mengembalikan nilai, contoh di bawah pilih range A1.setiap kali macro running akan menambah nilai di cell A1
Sub Count()
mycount = Range("a1") + 1
Range("a1") = mycount
End Sub
Current Date
ide yang bagus jika kita insert tanggal sekarang ketika akan menutup file, sebagai tanda file tersebut latest version/latest update.
dapat juga tanggal sekarang di letakan di footer ketika ingin print out.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Range("A1") = Now 'pilih sembarang cell tempat meletakkan tanggal nya
End Sub
jika yg dinginkan hanya tanggal
sub tanggal()
Range(A1") =date
End Sub
Current Cell Content
terkadang kita ingin tahu apa isi cell seperti , tanggal, text , atau formula
Sub ContentChk()
If Application.IsText(ActiveCell) = True Then
MsgBox "Text" 'ganti baris ini dengan kode macro yang di inginkan
Else
If ActiveCell = "" Then
MsgBox "Blank cell" 'ganti baris ini dengan kode macro yang di inginkan
Else
End If
If ActiveCell.HasFormula Then
MsgBox "formula" 'ganti baris ini dengan kode macro yang di inginkan
Else
End If
If IsDate(ActiveCell.Value) = True Then
MsgBox "date" 'ganti baris ini dengan kode macro yang di inginkan
Else
End If
End If
End Sub
Current Cell Address
untuk mengetahui cell adress yang sedang aktif, ini berguna jika ingin membuat formula
Sub MyAddress()
MsgBox ActiveCell.Address
MsgBox ActiveCell.Address(RowAbsolute:=False, columnAbsolute:=False)
Current Cell Position
untuk mengetahui posisi cell yang sedang aktif,
Sub MyPosition()
myRow = ActiveCell.Row
myCol = ActiveCell.Column
Msgbox myRow & "," & myCol
End Sub
Deleting Empty Rows
untuk delete rows yang kosong
Sub DelEmptyRow()
Rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False
For i = 1 To Rng
If ActiveCell.Value = "" Then 'ganti "" dengan 0 untuk mengahpus row yang 0
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Next i
Application.ScreenUpdating = True
End Sub
statement "Application.ScreenUpdating = False" untuk mencegah screen updating flah, ini untuk mempercepat kerja macro, jangan lupa untuk mengembalikan ke true
Deleting Range Names
untuk mengahpus semua range name dalam work book, ini trick nya
Sub DeleteNames()
Dim NameX As Name
For Each NameX In Names
ActiveWorkbook.Names(NameX.Name).Delete
Next NameX
End Sub
Duplicates
adakalanya kita ingin mengetahui data yang kembar dalan work sheet, ini trick macro nya
Sub DupsRed()
Application.ScreenUpdating = False
Rng = Selection.Rows.Count
For i = Rng To 1 Step -1
myCheck = ActiveCell
ActiveCell.Offset(1, 0).Select
For j = 1 To i
If ActiveCell = myCheck Then
Selection.Font.Bold = True
Selection.Font.ColorIndex = 3
End If
ActiveCell.Offset(1, 0).Select
Next j
ActiveCell.Offset(-i, 0).Select
Next i
Application.ScreenUpdating = True
End Sub
Emailing Workbook
untuk mengirimkan kan workbook melalui email
Sub Email()
ActiveWorkbook.SendMail recipients:="effendiwijaya@gmail.com"
End Sub
Error Trapping
error traping sangat berguna bagi user agar tahu apa yg dilkukan jika ada kesalahan
- On Error Resume Next atau
- On Error Goto ErrorTrap1
... more lines of code
ErrorTrap1:
... more code (what to do if there is an error)
statement pertama akan melanjutkan ke kode berikut nya jika ada error, sedangkan statement kedua akan menjalankan kode yang lain, pilih aja salah satu
Excel Functions
menggunakan function di VBA excel sama dengan yang digunakan di spread sheet, contoh untuk round up angka 2 decimal di dalam spread sheet akan seperti ini :
=round(1.2345,2)
dalam VBA Excel seperti ini ( menggunakan Aplication ) dan di ikuti dengan function, contoh
ActiveCell = Application.round(ActiveCell, 2)
Functions
membuat fungsi sendiri di excel akan sangat berguna untuk formula yang sangat comlicated jadi lebih mudah di bandingkan dengan spread sheet, formula dapat di protect , sehingga tidak dapat di lihat atau di di modifikasi oleh user. contoh
Public Function tax(income As Single)
Select Case income
Case Is <= 2500
tax = 0
Case Is <= 5000
tax = (income - 2500) * 0.05
Case Else
tax = (income - 5000) * 0.1 + 125
End Select
End Function
Goto (a range)
Sub GoHere()
Application.Goto Reference:="Sales" atau Range("Sales").Select
End Sub
Going to the 1st Sheet
untuk memilih sheet 1 tanpa mengetahui nama sheet nya
Sub FirstSheet()
Sheets(1).Select
End Sub
GoTo Sheet
terkadang kita punya banyak sheet dengan nama yang panjang sehingga kita dapat melihat nya satu satu.kita dapt memilih sheet nya dengan menggunakan macro
Sub Go2sheet()
myShts = ActiveWorkbook.Sheets.Count
For i = 1 To myShts
myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr
Next i
Dim mySht As Single
mySht = InputBox("Select sheet to go to." & vbCr & vbCr & myList)
Sheets(mySht).Select
End Sub
Hiding Sheets
hide worksheet sehingga sheet tidak dapat di lihat user.
Sub HideSheet()
Sheet1.Visible = xlSheetVeryHidden
End Sub
jika memaki cara ini , user tidak dapat meng unhide menggunakan menu, hanya pakai macro dapat di tampilkan lagi
Input Box
Ketika ingin mendapatkan input dari user, bisa gunakan input Boxs method.macro akan menanyakan user nama dan akan menampilkan di massage box + nama user tersebut
Sub GetInput()
Dim MyInput 'This line of code is optional
MyInput = InputBox("Enter your name")
MsgBox ("Hello ") & MyInput
End Sub
Inserting Rows
untuk insert rows yg di inginkan dari user sangat mudah..input box di gunakan untuk menentukan berapa row yang akan di tambahkan
Sub InsertRow()
Dim Rng
Rng = InputBox("Enter number of rows required.")
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(Rng - 1, 0)).Select
Selection.EntireRow.Insert
End Sub
Joining Text Together
untuk menggabungkan text
Sub JoinText()
myCol = Selection.Columns.Count
For i = 1 To myCol
ActiveCell = ActiveCell.Offset(0, 0) & ActiveCell.Offset(0, i)
ActiveCell.Offset(0, i) = ""
Next i
End Sub
Killing Files
killing atau delete file sangat mudah, syarat nya file sedang tidak di gunakan
Sub Killfile()
Dim MyFile As String 'This line of code is optional
On Error Resume Next 'On hitting errors, code resumes next code
MyFile = "c:\folder\filename.xls"
kill MyFile
End Sub
Lower Case
untuk mengganti taxt yg di pilih ke huruf kecil
Sub LowerCase()
Dim cell As Range
For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = LCase(cell)
End If
Next
End Sub
Last Available Row
untuk memilih next rows yang kosong
Sub LastRow()
Range("a65536").End(xlUp).Offset(1, 0).Select
End Sub
Message Box
3 type message box , silahkan coba satu satu mana yg sesuai untuk kebutuhan.
Sub MyMessage()
MsgBox "This macro is created by Effendi Wijaya"
MsgBox "The icon is different", vbInformation
MsgBox "The top title is different", vbExclamation, "Effendi Wijaya"
End Sub
Moving your cursor
pindah kursor sangat mudah, dan akan sangat sering di gunakan
Sub Down()
ActiveCell.Offset(1, 0).Select
End Sub
Sub up()
ActiveCell.Offset(-1, 0).Select
End Sub
Sub Right()
ActiveCell.Offset(0, 1).Select
End Sub
Sub Left()
ActiveCell.Offset(0, -1).Select
End Sub
Protecting / Unprotecting a sheet
The macros below will protect/unprotect the current worksheet with a password.
Sub ProtectSheet()
Dim Password 'This line of code is optional
Password = "1234"
ActiveSheet.Protect Password, True, True, True
End Sub
Sub UnProtectSheet()
Password = "1234"
ActiveSheet.Unprotect Password
End Sub
Protecting all sheets
untuk memprotect semua sheet
Sub protectAll()
Dim myCount 'This line of code is optional
Dim i 'This line of code is optional
myCount = Application.Sheets.Count
Sheets(1).Select 'This line of code selects the 1st sheet
For i = 1 To myCount
ActiveSheet.Protect
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Range Names
membuat name range pada range yg di pilih
Sub RngName()
Selection.Name = "myRange"
End Sub
Saving a file
Sub Save()
ActiveWorkbook.Save
End Sub
Sub SaveName()
ActiveWorkbook.SaveAs Filename:="C:\MyFile.xls"
End Sub
Sub SaveAll()
myFile = ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWindow.ActivateNext
Do While myFile <> ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWindow.ActivateNext
Loop
End Sub
Select Data Range
Sub SelAllData()
Application.ScreenUpdating = False
Dim myLastRow As Long
Dim myLastColumn As Long
Range("A1").Select
On Error Resume Next
myLastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
myLastColumn = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
myLastCell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & myLastCell
Application.ScreenUpdating = True
Range(myRange).Select
End Sub
Timer
untuk mengetahui dan mengukur waktu tunggu sebelum kode yang lain running
Sub timer()
Application.Wait Now + TimeValue("00:00:10")
MsgBox ("10 sec has elasped")
End Sub
Upper Case
merubah text ke huruf kapital
Sub UpperCase()
Dim cell As Range
For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = UCase(cell)
End If
Next
End Sub
vbYesNo
adakalanya kita ingin user memilih yes atau no, gunakan code di bawah ini
YesNo = MsgBox("This macro will ... Do you want to continue?", vbYesNo + vbCritical, "Caution")
Select Case YesNo
Case vbYes
'Insert your code here if Yes is clicked
Case vbNo
'Insert your code here if No is clicked
End Select
8 Comments
maturnuwun dan terima kasih dapat membantu belajar
ReplyDeletesama sama gan
Deletegmana caranya mengambil nama file yang sedang aktif kedalam variable.
ReplyDeletenamafile=active.workbook.name
DeleteBisa dijelaskan kapan macro ditulis dalam workbook, worksheet, dan module...
ReplyDeletejika keperluan nya hanya utk worksheet maka cukup tulis di worksheet, workbook bisa di gunakan di semua worksheet dan modul bisa di gunakan utk semua workbook.
Deleteminta penjelasan, bagaimana penggunaan sub, dim, private dll
ReplyDeletesub untuk membuat procedure, dim untuk asign variable dan private hanya di pakai utk perintah tertentu
Delete