Wednesday, July 3, 2013

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

No comments:

Post a Comment