Koleksi Macro Dasar Excel

Tulisan berikut ini merupakan terjemahan dari http://www.panzerbasics.com/index_files/97-excel/basic-macros.htm

Sebagai pemrogram VBA pemula, saya perlu mengumpulkan macro yang saya buat atau temukan. Menaruhnya di Internet hanyalah sebuah langkah lanjutan kecil.

Jika anda menjalankan sebuah macro, aksinya tidak bisa dibatalkan. Menggunakan macro yang disediakan di sini adalah urusan anda sendiri.

Camkanlah bahwa macro bisa sangat bermanfaat, namun juga bisa berbahaya jika berasal dari sumber yang tidak dikenal.

Code-code macro dasar berikut ini berasal dari seantero Internet atau dibuat oleh saya sendiri. Oleh karena sangat umum dan dasar, saya tidak mencantumkan sumbernya. Jika seseorang mengenalnya sebagai buatannya dan ingin namanya dicantumkan atau code dihapus, silahkan menghubungi saya.



Macro yang disediakan berikut ini adalah pilihan saya dan bisa digunakan sebagai permulaan atau untuk membantu anda pada proyek-proyek dasar. Gunakan imajinasi anda untuk menyesuaikannya dengan proyek anda, atau lakukan pencarian lebih lanjut di Internet.

Code-code sudah saya coba dan verifikasi untuk dijalankan pada Excel 2007. Harap diingat bahwa kita bisa mencapai suatu tujuan dengan cara yang berbeda.

Macro umumnya dimulai dengan baris: "Sub Name()", dimana Name bisa diganti dengan nama yang ingin anda gunakan. Macro diakhiri dengan baris "End Sub".

Untuk kejelasan dan kemudahan dalam pemakaian yang berbeda, saya tidak mencatumkan baris-baris ini lagi kecuali untuk alasan tertentu.

Jika "Sub" diganti dengan "Function", code akan berjalan sama saja, namun macro tidak tampak pada daftar macro yang tersedia. Kelemahan cara ini adalah function akan tampak dalam daftar function. Jika "Private" ditambahkan sebelum "Sub" atau "Function", macro hanya bisa dipanggil dari module yang sama, dan juga tidak muncul dalam daftar.

Activate	Sub Worksheet_Activate() MsgBox "Hello" End Sub
Active Cell, Position	myRow = ActiveCell.Row myCol = ActiveCell.Column MsgBox myRow & "," & myCol
Active Cell, Selection to far left	Selection.End(xlToLeft).Select OR Range("A" & ActiveCell.Row).Select
Active Cell in top left of screen	With ActiveWindow .ScrollColumn = ActiveCell.Column .ScrollRow = ActiveCell.Row End With
Active Cell, Value	MsgBox ActiveCell.Value
Auto Run	Sub Auto_Open() MsgBox "Hello" End Sub
Auto Run(2)	Sub Workbook_Open() MsgBox "Hello" End Sub
Auto Save	This workbook: ' = Autorun Sub Workbook_Open() Call SaveMe End Sub In Module: Sub SaveMe() ThisWorkbook.Save Application.OnTime Now + Timeserial(0,15,0),"SaveMe" ' Timeserial=(h,m,s) End Sub
Available Row (next)	Range("a65536").End(xlUp).Offset(1, 0).Select
Call - Running a subroutine	Call Macro2  'This calls for Macro2 to run within your Macro
Case Title	Dim cell As Range For Each cell In Selection.Cells If cell.HasFormula = False Then cell = Application.Proper(cell) End If Next
Case Upper / Lower	Dim cell As Range For Each cell In Selection.Cells If cell.HasFormula = False Then cell = UCase(cell) End If Next
Column Letters	Dim MyColumn As String, Here As String Here = ActiveCell.Address MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2) MsgBox MyColumn
Counting Rows & Columns	myRows = Selection.Rows.Count myColumns = Selection.Columns.Count MsgBox "Rows = " & myRows & vbCrLf & "Colums = " & myColumns
Carriage Return	MsgBox "Line 1" &  vbCrLf & "Line 2"
Copy Range (1)	Sheet1.Range("A1:C1").Copy Destination:=Sheet2.Range("A1")
Copy Range (2)	Range("A1:B1").Copy Range("A2").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False
Counter	Range("A1") = Range("A1") + 1 OR myCount = Range("a1") + 1 Range("a1") = myCount
Current Date	Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Range("A1") = Now End Sub
Delete Empty Rows	firstRow = Selection.Row lastRow = Selection.Row + Selection.Rows.Count  For rownumber = lastRow To firstRow Step -1   If Application.WorksheetFunction.CountA(Rows(rownumber)) = 0 _    Then Rows(rownumber).Delete  Next rownumber
Error Trapping	On Error Resume Next OR Sub Name() On Error Goto ErrorHandler1 ... more lines of code Exit Sub ErrorHandler1: ... code specifying action on error End Sub
File Name & Path	Range("A1") = Application.ActiveWorkbook.FullName
For, Next Loop
Goto (Code)
Input Box	Dim MyInput MyInput = InputBox("Enter something") Range("A1") = MyInput
If, Then Statement	If Range("B1") > 10 Then    Range("B2") = 10 ElseIf Range("B2") > 5 Then    Range("B2") = 5 Else    Range("B2") = 1 End If
Joining Text	myCol = Selection.Columns.Count - 1 n = 0    For n = 0 To Selection.Rows.Count - 1       For i = 1 To myCol          ActiveCell.Offset(n, 0) = ActiveCell.Offset(n, 0) & ActiveCell.Offset(n, i)          ActiveCell.Offset(n, i) = ""       Next i    Next n
Message Box	MsgBox "Created by: Your Name here" MsgBox "Different Icon", vbInformation MsgBox "Different Icon And Title", vbExclamation, "Your warning message"
Modeless Forms	UserForm.show vbModeless
Moving the Cursor	ActiveCell.Offset(1, 0).Select
Protecting / Unprotecting a sheet	'Protect Dim Password Password = "xxxx" ActiveSheet.Protect Password, True, True, True 'Unprotect Password = "xxxx" ActiveSheet.Unprotect Password
Random numbers	MyNumber = Int((10 - 1 + 1) * Rnd + 1) Range("A1") = MyNumber
Rounding Numbers	ActiveCell = Application.round(ActiveCell, 2)
Saving your Workbook	ActiveWorkbook.Save
ScreenUpdating	Application.ScreenUpdating = False / True
Select Case statement	Select Case Range("A1").Value    Case 100, 150 ' = 100 OR 150       Range("B1").Value = Range("A1").Value    Case 200 To 300, 400 To 500 ' = Between 200 and 300 OR between 400 and 500       Range("B2").Value = Range("A1").Value    Case Else       Range("B1").Value = 0 End Select
Select Data Range	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 myRange = "a1:" & Cells(myLastRow, myLastColumn).Address Range(myRange).Select
Sheets Hiding	Sheet1.Visible = xlSheetVeryHidden
Text Edit	MsgBox Left("abcd", 2)       'Displays 2 characters from Left MsgBox Right("abcd", 2)    'Displays 2 characters from Right MsgBox Len("abcd")           'Displays number of characters (Including space)
Timer	Application.Wait Now + TimeValue("00:00:05") MsgBox ("This was a 5 second delay")
Time last save	MsgBox Excel.Application.ThisWorkbook.BuiltinDocumentProperties("Last Save Time")
vbYesNo	YesNo = MsgBox("This macro will ... Do you want to continue?", vbYesNo + vbCritical, "Caution") Select Case YesNo Case vbYes 'Insert your "Yes" code here. Case vbNo 'Insert your "No" code here. End Select