HeSanbi
Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
- Tham gia
- 24/2/13
- Bài viết
- 2,382
- Được thích
- 3,535
- Giới tính
- Nam
Để bắt đầu học Lập trình VBA một cách tốt nhất, các bạn hãy thử theo cách sau của tôi, nếu thấy hay thì có thể vận dụng:
1. Học cửa sổ VBE , menu và các nút trên VBE
2. Học cách Debug một dòng code (Phải biết), Cách Debug đi đôi với cửa sổ Local Window và Watch Window để xem code chạy từng dòng như thế nào ở menu Debug.
3. Tìm kiếm hàm, các hằng (ví dụ: vbBlack, vbNullString, ...) , các phương thức,... trong: Object Browers ( Ấn F2 ) (Rất quan trọng)
4. Học cách tìm kiếm và thay thế: Trong cửa sổ VBE ấn Ctrl + F hoặc Ctrl + H
5. Các Cửa sổ VBE: Immediate (Ctrl + g), Locals Window, Watch Window
7. Cách thêm References
8. Học VBIDE để biết cách tạo module, class module, ... của Excel và VBA bằng chính VBA
9. Học các Hàm, Các phương thức hướng sự kiện. (Vận dụng tìm kiếm trong Object Browers)
Cách bắt sự kiện Application (Thường là một Add-Ins ) , Workbook, Worksheet, Userform
10. Học căn bản VBA. Module VBA basic dưới kia và *Tham Khảo học: http://viettuts.vn/excel-vba
Hàm dbPrint của tôi có thể giúp đỡ các bạn lập trình Mảng tốt hơn.
11. Sau khi viết code xong Các file có thể lưu được Code VBA:
Còn sơ sài, sai sót, nên các bạn biết nhiều về VBA có thể góp thêm các cách hay.
------------------------------------------
Nếu các bạn thấy hay hãy chia sẽ bằng cách Đăng bài trả lời ở bài viết này!
------------------------------------------
Module Này chỉ là ý kiến cá nhân của tôi, dùng để xem những gì căn bản nhất, và chạy test các thủ tục.
Các bạn cần Vào cửa sổ VBE - Vào Tools - Vào References - tìm thêm Microsoft Scripting Runtime để module đủ điều kiện chạy các khai báo Object (Đối tượng)
Các bạn copy Bằng cách Ấn vào "Sao chép"
Liên hệ:
Facebook: fb.com/he.sanbi hoặc tìm kiếm he.sanbi
1. Học cửa sổ VBE , menu và các nút trên VBE
2. Học cách Debug một dòng code (Phải biết), Cách Debug đi đôi với cửa sổ Local Window và Watch Window để xem code chạy từng dòng như thế nào ở menu Debug.
+ Viết code với chế độ Debug Mỗi lần viết đoạn Code xong là Ấn "Compile ..." để soát lỗi
+ Chạy Code (F5) để soát lỗi
3. Tìm kiếm hàm, các hằng (ví dụ: vbBlack, vbNullString, ...) , các phương thức,... trong: Object Browers ( Ấn F2 ) (Rất quan trọng)
4. Học cách tìm kiếm và thay thế: Trong cửa sổ VBE ấn Ctrl + F hoặc Ctrl + H
5. Các Cửa sổ VBE: Immediate (Ctrl + g), Locals Window, Watch Window
+ Immediate: Debug trong Immediate rất hay để các bạn có thể viết hàm để chạy thử.
++ Nếu là Function thì Gõ chuỗi vào cửa sổ Immediate và ấn Enter:
?TestFunction(Var1,Var2, ...)
?1 = 2
?TypeName(Worksheets)
++ Với Sub thì không cần dấu ?
+ Locals Window và Watch Window: Đánh dấu Breakpoint chạy debug (Dấu tròn đỏ trước dòng code), thì cửa sổ này sẽ diễn giải code đang chạy từng dòng như thế nào
6. Các phím tắt VBE: https://www.excelcampus.com/vba/excel-vba-macro-shortcuts/7. Cách thêm References
8. Học VBIDE để biết cách tạo module, class module, ... của Excel và VBA bằng chính VBA
9. Học các Hàm, Các phương thức hướng sự kiện. (Vận dụng tìm kiếm trong Object Browers)
Cách bắt sự kiện Application (Thường là một Add-Ins ) , Workbook, Worksheet, Userform
10. Học căn bản VBA. Module VBA basic dưới kia và *Tham Khảo học: http://viettuts.vn/excel-vba
Hàm dbPrint của tôi có thể giúp đỡ các bạn lập trình Mảng tốt hơn.
11. Sau khi viết code xong Các file có thể lưu được Code VBA:
+ Với trang tính: xls, xlsm, xlsb (Khuyên dùng)
+ Add-ins và Style Sheet: xla, xlam (Khuyên dùng), sxl
Còn sơ sài, sai sót, nên các bạn biết nhiều về VBA có thể góp thêm các cách hay.
------------------------------------------
Nếu các bạn thấy hay hãy chia sẽ bằng cách Đăng bài trả lời ở bài viết này!
------------------------------------------
Module Này chỉ là ý kiến cá nhân của tôi, dùng để xem những gì căn bản nhất, và chạy test các thủ tục.
Các bạn cần Vào cửa sổ VBE - Vào Tools - Vào References - tìm thêm Microsoft Scripting Runtime để module đủ điều kiện chạy các khai báo Object (Đối tượng)
Các bạn copy Bằng cách Ấn vào "Sao chép"
PHP:
' ++=========================================================================++
' || ||
' || modVBA_Basic ||
' || ||
' ++=========================================================================++
'Tien Xu ly
Option Explicit
Option Compare Binary '/Option Compare Binary
'Text: Sort -> A Á À B
'Binary: Sort -> A B Á À
Option Base 0 '/Option Base 1
'Start Index Array number is 0 / 1
'Array(0,1,2,3,4) / Array(1,2,3,4)
'+==============================================================+
'| Comment |
'+==============================================================+
'Comment with '
#Const AAAAAAAAAA1 = 1 ' Not Use ":"
Rem Comment with Rem
'#Const AAAAAAAAAA1 = 1: Rem Test -> Error
Global AAAAAAAAAA2: Rem <- Has ":"
Rem Not ":"
'+==============================================================+
'| Pretreatment |
'+==============================================================+
'*Pretreatment On Top
Option Private Module 'All Procedure in Module is Private
'Tien Xu ly bang dau #
#Const AAAAAAAAAAA = 1
#If AAAAAAAAAAA = 1 Then
#End If
#If Mac Then
#If Win64 Then
#Else
#End If
#ElseIf VBA7 Then
'Has PtrSafe
#If Win64 Then
'LongPtr / LongLong / Any
'Application.HinstancePtr
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) ' Variables
#ElseIf Win32 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else 'Win16 <-
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Variables
#End If
#Else
'Application.Hinstance
'Not PtrSafe
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
'+==============================================================+
'| Variables outside sub / function |
'+==============================================================+
'*Underneath of Pretreatment
'<define>setname.regex:(^[A-z])([\_A-z0-9]*).for:variable|sub|function|class|module|enum|type</define>
Global name_variable As String '<Data-Type>String
Global VarGlobal2$ '<!>Global VarGlobal2 $<Data-Type>String
Global VarGlobal3 '<Data-Type>Variant
Global VarGlobal4() '<Data-Type>Early Binding Array Variant
'
'</define-project>
Public Const MARKER As String = "NOT_TopMOST" '<Data-Type~Global>
Private Const myDefaulPrivate As Integer = 16
Public Const myDefaultPublic As Integer = 16
Dim myaaa As Integer
'+==============================================================+
'| Variables Define Handle |
'+==============================================================+
'Private / Public
Type myTypeExam
childType As Long
'childType& ' -> Error
'...
End Type
Enum myEnum
childEnum1 = 1
childEnum2 ' -> = 2
childEnum5 = 8
childEnum6 '-> = 9
'...
End Enum
Enum myLanguage
[_First]
Albanian
Armenian
'...
French
English
'...
[_Last]
End Enum
Sub GoTo_BVBA_Range()
Application.Goto Reference:="basic_Variables_outside"
End Sub
Sub basic_Variables_outside()
Debug.Print myEnum.childEnum1
Dim MyVar As myTypeExam
MyVar.childType = 2
Debug.Print MyVar.childType
Debug.Print basic_VariablesDefineHandle(childEnum1)
Dim i As Long
For i = myLanguage.[_First] To myLanguage.[_Last]
If i = French Then
Debug.Print "Found French - index " & i
Exit For
End If
Next i
End Sub
Function basic_VariablesDefineHandle(num As myEnum)
basic_VariablesDefineHandle = num
End Function
Sub NewShortKeys()
With Application
.OnKey "^q", "Marco1" 'Ctrl+Q
.OnKey "^w", "Marco2" 'Ctrl+W
.OnKey "^A", "Marco3" 'Ctrl+A
.OnKey "^Q", "Marco4" 'Ctrl+Shift+Q
.OnKey "^W", "Marco5" 'Ctrl+Shift+W
.OnKey "^Z", "Marco6" 'Ctrl+Shift+Z
.OnKey "^e", "Marco7" 'Ctrl+E
.OnKey "%q", "Marco8" 'Alt +Q
.OnKey "%f", "Marco9" 'Alt +F
.OnKey "^V", "Marco10" 'Ctrl+V
.OnKey "^X", "Marco11" 'Ctrl+X
.OnKey "^S", "Marco12" 'Ctrl+S
.OnKey "%r", "Marco13" 'Alt+R
.OnKey "%b", "Marco14" 'Alt+B
.OnKey "%y", "Marco15" 'Alt+Y
.OnKey "%j", "Marco16" 'Alt+J
.OnKey "^N", "Marco17" 'Ctrl+Shift+N
.OnKey "^T", "Marco18" 'Ctrl+Shift+T
.OnKey "^D", "Marco19" 'Ctrl+Shift+D
.OnKey "^G", "Marco20" 'Ctrl+Shift+G
.OnKey "^K", "Marco21" 'Ctrl+Shift+K
.OnKey "^H", "Marco22" 'Ctrl+Shift+H
.OnKey "^U", "Marco23" 'Ctrl+Shift+U
.OnKey "^I", "Marco24" 'Ctrl+Shift+I
.OnKey "^O", "Marco25" 'Ctrl+Shift+O
.OnKey "^P", "Marco26" 'Ctrl+Shift+P
.OnKey "^L", "Marco27" 'Ctrl+Shift+L
.OnKey "^M", "Marco28" 'Ctrl+Shift+M
End With
End Sub
'+==============================================================+
'| Later / Early Binding |
'+==============================================================+
Sub LaterOrEarlyBinding()
'Early Binding
Dim SCt2 As Scripting.Dictionary ' Object
Set SCt2 = New Scripting.Dictionary
'Later Binding
Set SCt2 = CreateObject("Scripting.Dictionary")
End Sub
'+==============================================================+
'| Variables on Sub / Function |
'+==============================================================+
'...................Basic:
'Code: { ""|Public / Private } + { Sub / Function } + { NameSub } + ( { Cluster VarName / ParamArray VarName} ) + { As Variables(Only Function) }
'---------------------------------------------------------------------------------------------------------------------------------------------------
'.......Cluster Variables:
'Code: { "" /Optional } + { "" | ByVal / ByRef } + { VarName } + { As Variables / "" }
'-------------------------------------------------------------------------------------
'..............ParamArray:
'1. ParamArray is lies behind the Variables
'2. Behind the Variables is ParamArray
'3. Every Sub / Function contain only one ParamArray
'4. Exam: Go to Run Sub Call_Get_Set_Assign_ParamArray_______myFuncExam()
'.............ByVal/ByRef:
'1. ByRef:
Sub basic_Test_BR()
Dim X As Integer
X = 10
Debug.Print TripleByRef(X) 'Can Get x in ByRef
Debug.Print X '-> x change: x = 30
Debug.Print TripleByRef(X) '-> x change: x = 90
'selected Macro
Application.Goto "basic_Test_BV"
End Sub
Function TripleByRef(ByRef X As Integer) As Integer
X = X * 3
TripleByRef = X
End Function
'2. ByVal:
Sub basic_Test_BV()
Dim X As Integer
X = 10
Debug.Print TripleByVal(X) 'Can Not Get x with ByVal
Debug.Print X '-> x not change: x = 10
Debug.Print TripleByVal(X) 'x not change -> result 30, x = 10
End Sub
Function TripleByVal(ByVal X As Integer) As Integer
X = X * 3
TripleByVal = X
End Function
'+==============================================================+
'| Declare |
'+==============================================================+
'public / private
Sub basic_Declare()
' STARTS LIST - starts of structures that contain lines to indent
Dim StructureStarts
StructureStarts = Array( _
"Do", "Do *", "Do: *", _
"For *", _
"If * Then", "If * Then: *", "If * Then [!A-Z,!a-z]*", _
"Select Case *", _
"Type *", "Private Type *", "Public Type *", _
"While *", _
"With *", _
"Sub *", "Static Sub *", "Private Sub *", "Public Sub *", "Friend Sub *", _
"Private Static Sub *", "Public Static Sub *", "Friend Static Sub *", _
"Function *", "Static Function *", "Private Function *", _
"Public Function *", "Friend Function *", "Private Static Function *", _
"Public Static Function *", "Friend Static Function, *", _
"Property Get *", "Static Property Get *", "Private Property Get *", _
"Public Property Get *", "Friend Property Get *", _
"Private Static Property Get *", "Public Static Property Get *", _
"Friend Static Property Get *", _
"Property Let *", "Static Property Let *", "Private Property Let *", _
"Public Property Let *", "Friend Property Let *", _
"Private Static Property Let *", "Public Static Property Let *", _
"Friend Static Property Let *", _
"Property Set *", "Static Property Set *", "Private Property Set *", _
"Public Property Set *", "Friend Property Set *", _
"Private Static Property Set *", "Public Static Property Set *", _
"Friend Static Property Set *")
' ENDS LIST - ends of structures that contain lines to indent
Dim StructureEnds
StructureEnds = Array( _
"Loop", "Loop *", "Loop: *", _
"Next", "Next *", "Next: *", _
"End If", "End If *", "End If: *", _
"End Select", "End Select *", "End Select: *", _
"End Type", "End Type *", "End Type: *", _
"Wend", "Wend *", "Wend: *", _
"End With", "End With *", "End With: *", _
"End Sub", "End Sub *", _
"End Function", "End Function *", _
"End Property", "End Property *", "End Property: *")
' OUTDENTS LIST - exceptions that need re-aligned with respective start elements
Dim Outdents
Outdents = Array( _
"Else", "Else *", "Else: *", "Else:", _
"ElseIf * Then", "ElseIf * Then*", _
"Case", "Case *", _
"Case Else", "Case Else:", "Case Else *", "Case Else:*")
End Sub
'-------------- Sub --------------
'+ Call | Get | ParramArray
'+ Call in button | Sub | Function | Events
Sub mySubExam1()
'Call
Dim getStr As Integer
'Get
mySubExam2 getStr 'Get "Assigned by" by Variables
Debug.Print getStr
'ParramArray - go tp Function example
End Sub
Sub mySubExam2(Inte As Integer)
Inte = 2
End Sub
'-------------- Function --------------
'+ Call | Get | Assign | Set | ParramArray
'+ Call in Cells | Sub | Function | Immediate | Events
Sub Call_Get_Set_Assign_ParamArray_______myFuncExam()
'Call
Call myFuncExam(True)
'Get
Dim getBool As Boolean
myFuncExam (getBool)
Debug.Print getBool
'Assign
Dim i As Long
i = myFuncExam(True)
Debug.Print i
'Set
Dim Obj As Object
'If myFuncExam is Object Then
'Set obj = myFuncExam
Debug.Print "Set"
'ParamArray 1
Call myFuncExam(True, 1, 2, 3) '-> arr = Array(1, 2, 3)
'ParamArray 2
Call myFuncExam(True, Array("a", "b", "c")) '-> arr = Array(Array("a", "b", "c"))
'ParamArray 3
Call myFuncExam(True, Array("e", "f"), Array("g", "h")) '-> arr = Array(Array("e", "f"),Array("g", "h"))
End Sub
Function myFuncExam(Bool As Boolean, ParamArray Arr() As Variant) As Integer
myFuncExam = 2
Bool = False
If Not IsMissing(Arr) Then
On Error GoTo ParamArray2
'ParamArray 1
Debug.Print Join(Arr, " ")
End If
Exit Function
ParamArray2:
Dim dArr, eArr
For Each eArr In Arr
For Each dArr In eArr
dbPrint dArr
Next dArr
Next eArr
End Function
'+==============================================================+
'| Input / Output |
'+==============================================================+
'Input by InputBox | MsgBox | Assign | { "..." }
'Input by Debug.Print | MsgBox | Assign | { "..." }
Sub basic_input_output()
Dim strPut As String
strPut = InputBox("Input: ") 'Input Handle
Debug.Print strPut 'Output Print
Dim msg, Style, Title, Help, Ctxt, myString
msg = "Do you want to continue?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "MsgBox Demonstration"
Help = "DEMO.HLP"
Ctxt = 1000
Dim msgPut
'MsgBox(prompt[,buttons][,title][,helpfile,context])
'Buttons:
'0 vbOKOnly
'1 vbOKCancel
'2 vbAbortRetryIgnore
'3 vbYesNoCancel
'4 vbYesNo
'5 vbRetryCancel
'16 vbCritical
'32 vbQuestion
'48 vbExclamation
'64 vbInformation
'0 vbDefaultButton1
'256 vbDefaultButton2
'512 vbDefaultButton3
'768 vbDefaultButton4
'0 vbApplicationModal
'4096 vbSystemModal
'Return:
'1 - vbOK - OK was clicked
'2 - vbCancel - Cancel was clicked
'3 - vbAbort - Abort was clicked
'4 - vbRetry - Retry was clicked
'5 - vbIgnore - Ignore was clicked
'6 - vbYes - Yes was clicked
'7 - vbNo - No was clicked
msgPut = MsgBox(msg, Style, Title, Help, Ctxt) 'Input
If msgPut = vbYes Then: MsgBox "vbYes" 'Output Alert
If msgPut = vbNo Then: Debug.Print "vbNo" 'Output Print
If msgPut = vbCancel Then: MsgBox "vbCancel" 'Output Alert
End Sub
'+==============================================================+
'| Variables inside |
'+==============================================================+
'&H : Hex
'&O : Octal
'String $
'Variant
'Byte
'Integer %
'Long &
'Single !
'Double #
'Currency @
'Decimal
'Win64 LongPtr / LongLong
Sub basic_Variables_inside()
Static Obj As Object
#If Win64 Then
Dim e As LongLong
#ElseIf Win32 Then
Dim e As Long
#Else
Dim e As Long
#End If
Dim a As String
Dim AA$, BB%, CC&, DD!, EE@, FF#
Dim B() As String 'B is Array
Dim C As String * 20 '20 character
Const MyInteger As Integer = 42 'MyInteger is Constants
End Sub
'+--------------------------------------------------------------+
'| Variables Function |
'+--------------------------------------------------------------+
Function basic_Variables_Function() As String
basic_Variables_Function = "Hello VBA"
End Function
'+--------------------------------------------------------------+
'| Loop |
'+--------------------------------------------------------------+
Private Sub test_basic_loop_For()
Dim i: i = 1
Do While i < 5 '(Loop If True <> Exit If False)
i = i + 1
Debug.Print "Do While", i
Loop
i = 1
Do
i = i + 1
Debug.Print "Loop While", i
Loop While i < 5 '(Loop If True <> Exit If False)
i = 0
Do Until i > 5 '(Loop If False <> Exit If True)
i = i + 1
Debug.Print "Do Until", i
Loop
i = 0
Do
i = i + 1
Debug.Print "Loop Until", i
Loop Until i > 5 '(Loop If False <> Exit If True)
End Sub
Sub basic_loop_For()
'For...Next()
Dim i As Long: For i = 0 To 1
Exit For
Next i
'For Each...Next()
Dim Ia: For Each Ia In Array(1, 2, 3)
Exit For
Next Ia
'Do ... Loop ----> Endless Loop - sTop by Exit Do
Do
DoEvents
If True Then Exit Do
Loop
i = 1
Do While i < 5 '(Loop If True <> Exit If False)
i = i + 1
Debug.Print "Do While", i
Loop
i = 1
Do
i = i + 1
Debug.Print "Loop While", i
Loop While i < 5 '(Loop If True <> Exit If False)
i = 0
Do Until i > 5 '(Loop If False <> Exit If True)
i = i + 1
Debug.Print "Do Until", i
Loop
i = 0
Do
i = i + 1
Debug.Print "Loop Until", i
Loop Until i > 5 '(Loop If False <> Exit If True)
'While ... Wend -----> sTop by Condition False
i = 0
While i <= 10
Debug.Print "While Wend", i
i = i + 1
Wend
End Sub
'+==============================================================+
'| Exit statements |
'+==============================================================+
'Exit { Do | For | Function | Property | Select | Sub | Try | While }
'+==============================================================+
'| Error Handing |
'+==============================================================+
'item Description
'----------------------------------------------------------------------------------------------------
'On Error Goto -1
'On Error Goto 0 When error occurs, the code sTops and displays the error.
'On Error Resume Next Ignores the error and continues on.
'On Error Goto [Label] Goes to a specific label when an error occurs.This allows us to handle the error.
'Err Object When an error occurs the error information is stored here.
'Err.Number The number of the error.(Only useful if you need to check a specific error occurred.)
'Err.Description Contains the error text.
'Err.Source You can populate this when you use Err.Raise.
'Err.Raise A function that allows you to generate your own error.
'Error Function Returns the error text from an error number.Obsolete.
'Error Statement Simulates an error. Use Err.Raise instead.
'----------------------------------------------------------------------------------------------------
'Code Message
'3 Return without GoSub.
'5 Invalid procedure call.
'6 Overflow.
'7 Out of memory.
'9 Subscript out of range.
'10 This array is fixed or temporarily locked.
'11 Division by zero.
'13 Type misMatch.
'14 Out of string space.
'16 Expression too complex.
'17 Can't perform requested operation.
'18 User interrupt occurred.
'20 Resume without error.
'28 Out of stack space.
'35 Sub, Function, or Property not defined.
'47 Too many DLL application clients.
'48 Error in loading DLL.
'49 Bad DLL calling convention.
'51 Internal error.
'52 Bad file name or number.
'53 File not found.
'54 Bad file mode.
'55 File already open.
'57 Device I/O error.
'58 File already exists.
'59 Bad record length.
'61 Disk full.
'62 Input past end of file.
'63 Bad record number.
'67 Too many files.
'68 Device unavailable.
'70 Permission denied.
'71 Disk not ready.
'74 Can't rename with different drive.
'75 Path/File access error.
'76 Path not found.
'91 Object variable or With block variable not set.
'92 For loop not initialized.
'93 Invalid pattern string.
'94 Invalid use of Null.
'97 Can't call Friend procedure on an object that is not an instance of the defining class.
'98 A property or method call cannot include a reference to a private object, either as an argument or as a return value.
'298 System DLL could not be loaded.
'320 Can't use character device names in specified file names.
'321 Invalid file format.
'322 Cant create necessary temporary file.
'325 Invalid format in resource file.
'327 Data value named not found.
'328 Illegal parameter; can't write arrays.
'335 Could not access system registry.
'336 Component not correctly registered.
'337 Component not found.
'338 Component did not run correctly.
'360 Object already loaded.
'361 Can't load or unload this object.
'363 Control specified not found.
'364 Object was unloaded.
'365 Unable to unload within this context.
'368 The specified file is out of date. This program requires a later version.
'371 The specified object can't be used as an owner form for Show.
'380 Invalid property value.
'381 Invalid property-array index.
'382 Property Set can't be executed at run time.
'383 Property Set can't be used with a read-only property.
'385 Need property-array index.
'387 Property Set not permitted.
'393 Property Get can't be executed at run time.
'394 Property Get can't be executed on write-only property.
'400 Form already displayed; can't show modally.
'402 Code must close Topmost modal form first.
'419 Permission to use object denied.
'422 Property not found.
'423 Property or method not found.
'424 Object required.
'425 Invalid object use.
'429 Component can't create object or return reference to this object.
'430 Class doesn't support Automation.
'432 File name or class name not found during Automation operation.
'438 Object doesn't support this property or method.
'440 Automation error.
'442 Connection to type library or object library for remote process has been lost.
'443 Automation object doesn't have a default value.
'445 Object doesn't support this action.
'446 Object doesn't support named arguments.
'447 Object doesn't support current locale setting.
'448 Named argument not found.
'449 Argument not optional or invalid property assignment.
'450 Wrong number of arguments or invalid property assignment.
'451 Object not a collection.
'452 Invalid ordinal.
'453 Specified not found.
'454 Code resource not found.
'455 Code resource lock error.
'457 This key is already associated with an element of this collection.
'458 Variable uses a type not supported in Visual Basic.
'459 This component doesn't support the set of events.
'460 Invalid Clipboard format.
'461 Method or data member not found.
'462 The remote server machine does not exist or is unavailable.
'463 Class not registered on local machine.
'480 Can't create AutoRedraw image.
'481 Invalid picture.
'482 Printer error.
'483 Printer driver does not support specified property.
'484 Problem getting printer information from the system. Make sure the printer is set up correctly.
'485 Invalid picture type.
'486 Can't print form image to this type of printer.
'520 Can't empty Clipboard.
'521 Can't open Clipboard.
'735 Can't save file to TEMP directory.
'744 Search text not found.
'746 Replacements too long.
'31001 Out of memory.
'31004 No object.
'31018 Class is not set.
'31027 Unable to activate object.
'31032 Unable to create embedded object.
'31036 Error saving to file.
'31037 Error loading from file.
'-------------------------------------------------------------------------------------------
Sub OnGosubGotoDemo()
Dim Number, myString
Number = 2 ' Initialize variable.
' Branch to Sub2.
On Number GoSub Sub1, sub2 ' Execution resumes here after
' On...GoSub.
On Number GoTo Line1, Line2 ' Branch to Line2.
' Execution does not resume here after On...GoTo.
Exit Sub
Sub1:
myString = "In Sub1": Return
sub2:
myString = "In Sub2": Return
Line1:
myString = "In Line1"
Line2:
myString = "In Line2"
End Sub
Sub UsingResumeNext()
On Error Resume Next
Dim X As Long, Y As Long
X = 6
Y = 6 / 0
X = 7
End Sub
Sub UsingGotoLine()
On Error GoTo EH
Dim X As Long, Y As Long
X = 6
Y = 6 / 0
X = 7
Done:
Exit Sub
EH:
MsgBox "The following error occurred: " & Err.Description
End Sub
Sub TwoErrors()
On Error GoTo EH
' generate "Type misMatch" error
Error (13)
Done:
Exit Sub
EH:
On Error GoTo eh_other
' generate "Application-defined" error
Error (1034)
Exit Sub
eh_other:
Debug.Print "ehother " & Err.Description
End Sub
Sub TwoErrors2()
On Error GoTo EH
' generate "Type misMatch" error
Error (13)
Done:
Exit Sub
EH:
' clear error
On Error GoTo -1
On Error GoTo eh_other
' generate "Application-defined" error
Error (1034)
Exit Sub
eh_other:
Debug.Print "ehother " & Err.Description
End Sub
Sub UsingErr()
10 On Error GoTo EH
Dim val As Long
20 val = "aa"
Done:
30 Exit Sub
EH:
40 Debug.Print Erl
End Sub
'----------------------------------------------------------------------------------------------------
Sub ReadWorksheet()
On Error GoTo EH
If True Then
Err.Raise 123456, "ReadWorksheet" _
, "The Value in the cell A1 must have exactly 5 characters."
End If
' continue on if cell has valid data
Dim iD As String
iD = 2
Done:
Exit Sub
EH:
' Err.Raise will send code to here
alert "Error found: " & Err.Description
End Sub
Sub UsingErrClear()
Dim Count As Long, i As Long
' Continue if error as we will check the error number
On Error Resume Next
For i = 0 To 9
' generate error for every second one
If i Mod 2 = 0 Then Error (13)
' Check for error
If Err.Number <> 0 Then
Count = Count + 1
Err.Clear ' Clear Err once it is counted
End If
Next
Debug.Print "The number of errors was: " & Count
End Sub
Sub Logger(sType As String, sSource As String, sDetails As String)
Dim sFileName As String
sFileName = "C:\temp\logging.txt"
' Archive file at certain size
If FileLen(sFileName) > 20000 Then
FileCopy sFileName _
, Replace(sFileName, ".txt", Format(Now, "ddmmyyyy hhmmss.txt"))
Kill sFileName
End If
' Open the file to write
Dim filenumber As Variant
filenumber = FreeFile
Open sFileName For Append As #filenumber
Print #filenumber, CStr(Now) & "," & sType & "," & sSource _
& "," & sDetails & "," & Application.UserName
Close #filenumber
End Sub
Sub SimDivError()
On Error GoTo EH
' This will create a division by zero error
Error 11
Exit Sub
EH:
Debug.Print Err.Number, Err.Description
End Sub
Sub RaiseError(ByVal errorno As Long, ByVal src As String _
, ByVal proc As String, ByVal desc As String, ByVal lineno As Long)
Dim sLineNo As Long, sSource As String
' If no marker then this is the first time RaiseError was called
If Left(src, Len(MARKER)) <> MARKER Then
' Add error line number if present
If lineno <> 0 Then
sSource = vbCrLf & "Line no: " & lineno & " "
End If
' Add marker and procedure to source
sSource = MARKER & sSource & vbCrLf & proc
Else
' If error has already been raised then just add on procedure Name
sSource = src & vbCrLf & proc
End If
' If the code sTops here, make sure DisplayError is placed in the Top most Sub
Err.Raise errorno, sSource, desc
End Sub
Sub DisplayError(ByVal src As String, ByVal desc As String _
, ByVal sProcName As String)
' Remove the marker
src = Replace(src, MARKER, "")
Dim sMsg As String
sMsg = "The following error occurred: " & vbCrLf & Err.Description _
& vbCrLf & vbCrLf & "Error Location is: "
sMsg = sMsg + src & vbCrLf & sProcName
' Display message
MsgBox sMsg, Title:="Error"
End Sub
Sub Topmost()
On Error GoTo EH
Level1
Done:
Exit Sub
EH:
DisplayError Err.Source, Err.Description, "Module1.Topmost"
End Sub
Sub Level1()
On Error GoTo EH
Level2
Done:
Exit Sub
EH:
RaiseError Err.Number, Err.Source, "Module1.Level1", Err.Description, Erl
End Sub
Sub Level2()
On Error GoTo EH
' Error here
Dim a As Long
a = "7 / 0"
Done:
Exit Sub
EH:
RaiseError Err.Number, Err.Source, "Module1.Level2", Err.Description, Erl
End Sub
Sub Level3()
On Error GoTo EH
' Error here
Dim a As Long
'Order Row
2 a = 1
4 a = 2
5 a = 3
6 a = 4
1000000 a = "7 / 0"
Done:
Exit Sub
EH:
Debug.Print Erl '=1000000
End Sub
'+==============================================================+
'| Break code |
'+==============================================================+
Sub basic_Break_STop()
'...any code here
Stop 'execution will sTop here, debugging will start here
'...the rest of the code
End Sub
Sub basic_Break_DebugAssert()
'...any code here
Debug.Assert False 'execution will sTop here, debugging will start here
'...the rest of the code
End Sub
'+==============================================================+
'| VBA - Decisions |
'+==============================================================+
Sub basic_decisions()
Dim val1 As Integer, val2 As Integer, maxOfTwo As Integer
Dim val3 As Integer
'Or
'Dim val1 As Integer
'Dim val2 As Integer
'----------------------
val1 = 1
val2 = 10
'Or
val1 = 1: val2 = 10
'Or
val1 = 1: val2 = 10
'----------------------
If val1 > val2 Then
maxOfTwo = val1
Else
maxOfTwo = val2
End If
'Or
maxOfTwo = IIf(val1 > val2, val1, val2)
'----------------------
Debug.Print maxOfTwo
'Cach 1:
If 1 = 2 Then
End If
'Cach 2:
If 1 = 2 Then:
'Cach 1:
If 1 = 2 Then
Else
End If
'Cach 2:
If 1 = 2 Then: Else:
'Cach 1:
If 1 = 2 Then
ElseIf 2 = 3 Then
Else
End If
Dim intVal As Integer
intVal = 10
Select Case intVal
Case 1
Debug.Print "The Value is 1"
Case 2 To 5
Debug.Print "The Value is between 1 and 5"
Case 6 To 10
Debug.Print "The Value is between 1 and 10"
Case 11, 12, 13
Debug.Print "The Value is either 11, 12 or 13"
Case Else
Debug.Print "Another Value"
End Select
Select Case intVal
Case Is <= 10
Debug.Print "The Value is less than or equal 10"
Case Is <= 20
Debug.Print "The Value is less than or equal 20"
Case Is <= 30, Is > 50
Debug.Print "The Value is less than or equal 30 or higher than 50"
Case Else
Debug.Print "Another Value"
End Select
End Sub
'+==============================================================+
'| VBA - Operators |
'+==============================================================+
'The Arithmatic Operators: + | - | * | / | % | ^
'The Comparison Operators: = | <> | > | < | >= | <=
'The Logical Operators: And | Or | Not | Xor
'The Concatenation Operators: + | &
'....................................................................................................
'+==============================================================+
'| VBA - Worksheets & Workbooks |
'+==============================================================+
Sub basic_VBA_Worksheets_Workbooks()
ActiveWorkbook.Worksheets(2).Range("A1").Value = "Off"
ActiveSheet.Range("A1").Value = "Off"
Dim wb As Workbook, WS As Worksheet
'---Workbooks---
Set wb = Application.Workbooks(1)
'Set wb = Application.Workbooks("Book1")
'---Worksheets---
Set WS = wb.Worksheets(1)
Set WS = wb.Worksheets(ActiveSheet.Name)
With ActiveSheet
End With
With Sheets(1)
End With
With Sheets(ActiveSheet.Name)
End With
End Sub
'+==============================================================+
'| VBA - Ranges & Cells |
'+==============================================================+
Sub basic_VBA_Ranges_Cells()
Dim aRng
aRng = Range("A1") '| aRng = [A1] | aRng= Cells(1, 1)
aRng = Range("A" & 1)
aRng = Range("A1:A" & 2)
aRng = Range("A1", Range("A2"))
Range("A1, D1").Value = "Off"
aRng = Range("A:A")
aRng = Sheets(1).Range("A1")
aRng = Cells(2, "D").Value
aRng = Range(Cells(1, 1), Cells(1, 2))
Range("A1") = "Off"
With Sheets(1)
aRng = .Range("A1") ' aRng = .[A1] | aRng = .Cells(1, 1)
End With
Dim bRng As Range
Set bRng = Range("A1:A2")
Set bRng = Intersect(Range("B:B"), ActiveSheet.UsedRange)
Set bRng = ActiveSheet.CurrentRegion
'Set rng = Range("CELL_Name") 'Referencing Named Ranges
'Select
Range("A1").Select
Debug.Print Range("A1").Value, Range("A1").Value2
Debug.Print Selection.Value
Debug.Print Range("A1").Row
Debug.Print Range("A1").Rows
Debug.Print Range("A1").Column
Debug.Print Range("A1").Columns
Debug.Print Range("A1").Rows
Debug.Print Range("A1").Resize(1, 1).Value
Debug.Print Range("A1").Offset(1, 2).Value
Debug.Print Range("A1").End(xlToLeft).Value
Debug.Print Range("A1").End(xlToRight).Value
Debug.Print Range("A1").End(xlDown).Value
Debug.Print Range("A1").End(xlUp).Value
Debug.Print Range("A1").End(xlDown).Row
End Sub
'+==============================================================+
'| VBA - Array |
'+==============================================================+
Sub basic_Array()
'Array Declaration:
Dim Arr1()
Dim Arr2(5)
Dim Arr3: Arr3 = Array("apple", "Orange", "Grapes")
'Assigning Values to an Array
Debug.Print Arr3(0)
ReDim Arr1(5)
ReDim Arr1(1 To 1, 1 To 1)
'ReDim Preserve arr1(7)
'Multi-Dimensional Arrays
Dim Arr4(2, 2) As Variant
Arr4(0, 0) = "Apple"
Arr4(0, 1) = "Orange"
Arr4(1, 0) = "Apple"
Arr4(1, 1) = "Orange"
If IsArray(Arr4) Then
Debug.Print LBound(Arr4, 1)
Debug.Print UBound(Arr4, 1)
Debug.Print UBound(Arr4, 2)
End If
Dim a, B, C, d As Variant, X
a = Array("Red", "Blue", "Yellow")
B = Filter(a, "B")
dbPrint B
For Each X In B
Debug.Print ("The Filter result 1: " & X)
Next
Dim AA As Variant
AA = Split("Red Blue Yellow", " ")
Debug.Print Join(AA, " - ")
End Sub
Private Sub test_ExampleParamArray()
ExampleParamArray 1, 2, 3, 4, 5
End Sub
Sub ExampleParamArray(ParamArray Arr())
Dim CArr
For Each CArr In Arr
Debug.Print CArr
Next
End Sub
Private Sub ConstantdemoClick()
Dim NumArray(3)
NumArray(0) = "VBScript"
NumArray(1) = 1.05
NumArray(2) = 25
NumArray(3) = #4/23/2013#
Dim dynamicArray()
ReDim dynamicArray(9) ' Allocate storage space.
Erase NumArray ' Each element is reinitialized.
Erase dynamicArray ' Free memory used by array.
Debug.Print ("The Value at Zeroth index of NumArray is " & NumArray(0))
Debug.Print ("The Value at First index of NumArray is " & NumArray(1))
Debug.Print ("The Value at Second index of NumArray is " & NumArray(2))
Debug.Print ("The Value at Third index of NumArray is " & NumArray(3))
End Sub
'+==============================================================+
'| VBA - User Defined Functions / Sub |
'+==============================================================+
Function findArea(Length As Double, Optional Width As Variant)
If IsMissing(Width) Then
findArea = Length * Length
Else
findArea = Length * Width
End If
End Function
Sub Area(X As Double, Y As Double)
MsgBox X * Y
End Sub
Sub Area2()
Dim Y&
If Y = 1 Then GoSub SubChangeY
MsgBox Y
Exit Sub
SubChangeY:
Y = 2
Return
End Sub
'+==============================================================+
'| VBA - Error Handling |
'+==============================================================+
'On Error { GoTo [ line | 0 | -1 ] | Resume Next }
Public Sub basic_Error_Handling()
Dim X, Y, z As Integer
X = 50
Y = 0
On Error Resume Next
z = X / Y
On Error GoTo 0
On Error Resume Next
z = X / Y
On Error GoTo -1
Err.Raise 1112
Select Case Err.Number
Case 1112
Debug.Print ("Error# 1112") & " : " & Err.Description
Case Else
Debug.Print "UNKNOWN ERROR - Error# " & Err.Number & " : " & Err.Description
End Select
Resume Next
On Error GoTo ErrorHandler
z = X / 0
ErrorHandler:
Select Case Err.Number
Case 11
Debug.Print ("Error# 11") & " : " & Err.Description
Case 20
Debug.Print ("Error# 20") & " : " & Err.Description
Case Else
Debug.Print "UNKNOWN ERROR - Error# " & Err.Number & " : " & Err.Description
End Select
Resume Next
End Sub
Public Sub basic_Error_RunTimeError()
Call Err.Raise(1, "DefineArray", "Not supported var type")
End Sub
'+==============================================================+
'| VBA - Array |
'+==============================================================+
'...............VBA Array Limits:
'maximum size of (2^31)-1 (equal to 2’147’483’647)
'memory used by the array (about 500MB for 32-bit VBA and about 4GB for 64-bit VBA)
'.......Typical VBA Array errors: Runtime Error 9: Subscript out of range
'............VBA Array Functions:
'LBound(Array, Rank)
'UBound(Array, Rank)
'ReDim
'ReDim Preserve
'Erase
'......One-dimensional VBA Array:
Sub basic_VBA_Array_onedim()
Dim Arr(3) 'index (0 ,1, 2)
Dim onedimArray(1 To 3) As Long 'index (1 ,2, 3)
'traverse (iterate) through a VBA Array
Dim arrItem
For Each arrItem In Arr
Debug.Print arrItem
Next arrItem
Dim i As Long
For i = LBound(Arr) To UBound(Arr)
Debug.Print Arr(i)
Next i
End Sub
'....Multi-dimensional VBA Array:
Sub basic_VBA_Array_Multidim()
Dim twodimArray(5, 15) As Long
twodimArray(1, 15) = 10
twodimArray(2, 10) = 10
Dim threedimArray(5, 10, 15) As Long
threedimArray(2, 10, 12) = 3
threedimArray(5, 10, 15) = 9
End Sub
'................Fixed VBA array:
Sub basic_VBA_Array_Fixed()
Dim dynamicArray() As String
ReDim dynamicArray(5)
ReDim dynamicArray(1 To 11)
'ReDim Statement – Resizing a Dynamic VBA Array
dynamicArray(2) = 5
ReDim Preserve dynamicArray(14)
End Sub
'.....Erasing Dynamic VBA Arrays:
Sub basic_VBA_Array_Erasing()
Dim Arr() As Long
ReDim Arr(100, 100)
Arr(1, 1) = 0
'...
Arr(100, 100) = 100
Debug.Print UBound(Arr) 'Result: 100
Debug.Print LBound(Arr) 'Result: 1
Erase Arr
End Sub
'...........Merging 2 VBA Arrays:
Function Merge(ByVal Arr1 As Variant, ByVal Arr2 As Variant) As Variant
Dim tmpArr As Variant, upper1 As Long, upper2 As Long
Dim higherUpper As Long, i As Long, newIndex As Long
upper1 = UBound(Arr1) + 1: upper2 = UBound(Arr2) + 1
higherUpper = IIf(upper1 >= upper2, upper1, upper2)
ReDim tmpArr(upper1 + upper2 - 1)
For i = 0 To higherUpper
If i < upper1 Then
tmpArr(newIndex) = Arr1(i)
newIndex = newIndex + 1
End If
If i < upper2 Then
tmpArr(newIndex) = Arr2(i)
newIndex = newIndex + 1
End If
Next i
Merge = tmpArr
End Function
'Comparing two arrays (1 Dimensional):
Function Compare1DArrays(ByVal Arr1 As Variant, ByVal Arr2 As Variant) As Boolean
Dim i As Long
For i = LBound(Arr1) To UBound(Arr1)
If Arr1(i) <> Arr2(i) Then
Compare1DArrays = False
Exit Function
End If
Next i
Compare1DArrays = True
End Function
'Sorting an array (1 Dimensional) – Quick Sort:
Public Sub QuickSort(vArray As Variant, lowerBound As Long, upperBound As Long)
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = lowerBound
tmpHi = upperBound
pivot = vArray((lowerBound + upperBound) \ 2)
While (tmpLow <= tmpHi)
While (vArray(tmpLow) < pivot And tmpLow < upperBound)
tmpLow = tmpLow + 1
Wend
While (pivot < vArray(tmpHi) And tmpHi > lowerBound)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (lowerBound < tmpHi) Then QuickSort vArray, lowerBound, tmpHi
If (tmpLow < upperBound) Then QuickSort vArray, tmpLow, upperBound
End Sub
'+==============================================================+
'| VBA - DICTIONARY AND OTHER DATA STRUCTURES |
'+==============================================================+
'....The VBA Dictionary object:
'_________________________example:
Sub basic_VBA_Dict()
Dim Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
Dim key, val
key = "SomeKey": val = "SomeValue"
If Not Dict.Exists(key) Then
Dict.Add key, val
End If
Debug.Print Dict.Count 'Result: 1
Set Dict = Nothing
End Sub
'_______Traversing items and keys:
Sub basic_VBA_DictTraversing()
Dim Dict As Object, key, val, Item
Set Dict = CreateObject("Scripting.Dictionary")
key = "Key1": val = "Val1"
Dict.Add key, val
key = "Key2": val = "Val2"
Dict.Add key, val
For Each key In Dict.Keys
Debug.Print key
Next key
For Each Item In Dict.Items
Debug.Print Item
Next Item
Set Dict = Nothing
End Sub
'__________________Removing items:
Sub basic_VBA_Dict_Removing_items()
Dim Dict As Object, key, val
Set Dict = CreateObject("Scripting.Dictionary")
key = "Key1": val = "Val1"
Dict.Add key, val
key = "Key2": val = "Val2"
Dict.Add key, val
Dict.Remove "Key2"
Dict.RemoveAll
Set Dict = Nothing
End Sub
'........The VBA ArrayList object:
Sub basic_VBA_ArrayList()
Dim arrList As Object, Item
Set arrList = CreateObject("System.Collections.ArrayList") 'Create the ArrayList
arrList.Add "hello"
arrList.Add "You"
arrList.Add "There"
arrList.Add "Man"
arrList.Remove "Man"
'Get number of items
Debug.Print arrList.Count 'Result: 3
For Each Item In arrList
Debug.Print Item
Next Item
End Sub
'...................The VBA Queue:
Sub basic_VBA_Queue()
Dim queue As Object, peekAtFirst, doesContain, firstInQueue
Set queue = CreateObject("System.Collections.Queue") 'Create the Queue
queue.Enqueue "hello"
queue.Enqueue "There"
queue.Enqueue "Mr"
queue.Enqueue "Smith"
peekAtFirst = queue.Peek() 'Result" "hello"
doesContain = queue.contains("htrh") 'Result: False
doesContain = queue.contains("hello") 'Result: True
'Get first item in Queue and remove it from the Queue
firstInQueue = queue.Dequeue() '"hello"
'Count items
Debug.Print queue.Count 'Result: 3
'Clear the Queue
queue.Clear
Set queue = Nothing
End Sub
'...................The VBA Stack:
Sub basic_VBA_Stack()
Dim stack As Object, peekAtTopOfStack, doesContain, TopStack
Set stack = CreateObject("System.Collections.Stack") 'Create Stack
stack.Push "hello"
stack.Push "There"
stack.Push "Mr"
stack.Push "Smith"
peekAtTopOfStack = stack.Peek()
doesContain = stack.contains("htrh") 'Result: False
doesContain = stack.contains("hello") 'Result: True
'Get item from the Top of the stack (LIFO)
TopStack = stack.Pop() 'Result: "Smith"
'Clear the Stack
stack.Clear
Set stack = Nothing
End Sub
'..Other useful data structures:
'_______Hashtable
'______SortedList
'+==============================================================+
'| VBA COLLECTION |
'+==============================================================+
Sub basic_VBA_COLLECTION()
Dim myCol As Collection
Set myCol = New Collection
'.....Adding items:
myCol.Add 10, key:="Key10" 'Items: 10
myCol.Add 20, "Key20" 'Items: 10, 20
myCol.Add 30, "Key30" 'Items: 10, 20, 30
myCol.Add 40, "Key40", Before:=1 'Items: 40, 10, 20, 30
myCol.Add 50, "Key50", After:=1 'Items: 40, 50, 10, 20, 30
'....Getting items:
Debug.Print myCol("Key10")
'...Removing items:
myCol.Remove (2) 'Items: 40, 10, 20, 30
'.........Clearing:
'.........Counting:
Debug.Print myCol.Count '4
'.......Traversing:
Dim it As Variant
For Each it In myCol
Debug.Print it '10, 20, 30
Next it
'Print items in Collection
Dim i As Long
For i = 1 To myCol.Count
Debug.Print myCol(i) '10, 20, 30
Next i
'Check if VBA Collection contains item:
Debug.Print CollectionContains(myCol, 20) 'True
Debug.Print CollectionContains(myCol, 60) 'False
Debug.Print myCol.Item(1)
'Convert VBA Collection to VBA Array:
Dim Arr() As Variant
Arr = CollectionToArray(myCol)
dbPrint Arr
End Sub
Function CollectionContains(myCol As Collection, checkVal As Variant) As Boolean
On Error Resume Next
CollectionContains = False
Dim it As Variant
For Each it In myCol
If it = checkVal Then
CollectionContains = True
Exit Function
End If
Next
End Function
Function CollectionToArray(Col As Collection) As Variant()
Dim Arr() As Variant, Index As Long, it As Variant
ReDim Arr(1 To Col.Count) As Variant
For Each it In Col
Index = Index + 1
Arr(Index) = it
Next it
CollectionToArray = Arr
End Function
'+==============================================================+
'| VBA - Class |
'+==============================================================+
'********************** Go to ClassModule "BasicClass"**********************
'......................Basic:
'___________Variables, Procedures and Functions
'________________Properties – Get, Let and Set:
'Get – return Value of the property
'Let – set the Value of the property
'Set – set the object Value of the property (if applies)
'____________Events – Initialize and Terminate:
'Private Sub Class_Initialize() – fired when the Class object is initialized e.g.
'Private Sub Class_Terminate() – fired when the Class object is destroyed e.g.
'__Instancing – Private vs. PublicNonCreatable:
'Private : New clause
'PublicNonCreatable: cannot be New clause
'+==============================================================+
'| VBA - PERFORMANCE |
'+==============================================================+
Sub basic_VBA_SpeedOn()
With Application
.Calculation = xlCalculationManual
.CalculateBeforeSave = False
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = True
.EnableCancelKey = xlErrorHandler
End With
ActiveSheet.DisplayPageBreaks = False
End Sub
Sub basic_VBA_SpeedOff()
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
ActiveSheet.DisplayPageBreaks = True
End SubLiên hệ:
Facebook: fb.com/he.sanbi hoặc tìm kiếm he.sanbi
Lần chỉnh sửa cuối:
