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 |
No comments:
Post a Comment