【新提醒】Excel VBA編程的工程性規(guī)劃

求知881 2017-07-25

展開全文

本帖最后由 wrove 于 2017-7-18 14:03 編輯

看過很多人寫的VBA代碼，一團一團的，一點規(guī)劃都沒有，為了VBA編程更具工程性，這里討論一下，并列出自己的一些建議：
0.給VBA工程定義一個名字，而非直接使用默認的名稱——"VBAProject"，以方便以后可能要進行的跨VBA工程編碼
1.定義一個命名為“O”的標準模塊【拼音中“O”字母的讀音，意指“我”這個字】，用于定義所有的全局對象，管理本工程的代碼與數據，主要API：
[1]About(Optional ShowDetail As Boolean = False)函數：對本工程的各方面的自述，方便查看本工程的各類信息，可以多設置一個信息開關參數，如
這里的ShowDetail參數，比如再增加ShowCodeLinesCount參數
[2]Public Property Get Project() As VBIDE.VBProject，對本工程的VBA工程的引用
[3]Public Property Get VBAType() As VBAType，對本工程的VBA類型的定義，比如是在Excel，亦或是Word中，其中VBAType是自定義的Enum
[4]Initialize()函數：初始化本工程所有需要初始化的內容
[5]Terminate()函數：銷毀所有需要銷毀的
[6]HasLib(Byval LibName As String)函數：檢查本工程是否有某COM的引用，主要是檢查O.Project.References集合，比如O.HasLib("Scripting")，方便
可能需要的動態(tài)自動編碼
[7]HasModule(Byval ModuleName As String)函數：檢查本工程是否存在某個模塊
[8]Property Get/Let NextErrorNumber：用于規(guī)劃本工程自定義錯誤號，使每個錯誤號都是特有的，自定義錯誤的拋出如下：

''第二個參數是在設置Err.Source屬性，形式為：VBA工程名+模塊名+方法/函數/屬性名，
''如果是屬性，屬性名后面還建議加一個后綴#Get/#Let/#Set，以示錯誤的更具體來源
''使用“#”而不是“_”，是因為“_”是合法的標識符字符，可能帶來含義混淆
Err.Raise -2147221406, "Nutix.Output.Format", "Values參數包含的值的個數與txt參數中格式化標識個數不相等"

復制代碼

[9]Bake()函數：對本工程進行備份
[10]Move()函數：將本工程的所有代碼遷移到另外一個支持VBA的文件中
[11]Activate(Byval ModuleName As String)函數：將某模塊的代碼窗口打開
[12]各種全局對象的聲明，在聲明中建議直接帶New關鍵字，這樣會避免掉很多Set語句，而且因為New關鍵字是在對應的對象變量被實際訪問時，
      才真正執(zhí)行對應的New操作，所以如果有必要，請在上面的Initialize()函數中，定義某些必須立即初始化的對象的初始化；集中在這個模塊聲明
      也能方便對應全局變量的管理與訪問，比如對象變量名稱很長，直接O.XXX會更方便輸入，畢竟有智能成員提示嘛，而且O模塊名只有一個字
      符。另外，集中初始化與銷毀，也能避免漏操作。
[13]常見的第三方功能對象：
      (1)Scripting.FileSystemObject對象，全局命名為FSO
      (2)VBS_RegExp_55.RegExp對象，全局命名為RE
      (3)MSForms.DataObject對象，全局命名為Clip
      (4)Shell32.Shell對象，全局命名為SH
      (5)IWshRuntimeLibrary.WshShell對象，全局命名為WSH
      (6)MSComDlg.CommonDialog對象，全局命名為CD
2.定義一個命名為Enums標準模塊，存放所有的自定義Enum
3.定義一個命名為Types標準模塊，存放所有的自定義Type結構體
4.定義一個命名為Constants標準模塊，存放所有自定義的常數
5.定義一個命名為API標準模塊，存放所有對Windows API聲明及擴展
6.定義一個命名為Main標準模塊，作為本工程的工作模塊，所有的編碼，在本模塊測試，通用的測試也存放在本模塊，以方便查閱，來了解VBA的特性，尤其是不常用的對象，你可能某一時候學會了使用它的API，但長久不用，就又忘了，如果將當初的試驗代碼，很好的命名，并保存于此模塊，也會方便你再次熟悉這種對象。
7.定義一系列X_XXX類模塊，用于對VBA的標準類型，或引用的第三方類型，或VBA固有的對象，進行功能性增強
[1]比如對Collection/Array/Dictionary/VB（這里指的是VBA庫，因為VBA與VB的相似性，這里寫成VB而非VBA）/VBE（你寫VBA代碼的那個窗口）
      /Designer（VBE的窗體設計器）/Math/String/RegExp/ErrObject/FileSystemObject類型或對象的增強，分別定義如X_Collection/X_Array
   /X_Dictionary/X_VB/X_VBE/X_Designer/X_Math/X_String/X_RegExp/X_ErrObject/X_FileSystemObject的類模塊；
[2]在O模塊中分別定義一個全局的該類模塊的實例對象，分別命名為xCollection/xArray/xDictionary/xVB/xVBE/xDesigner/xMath/xString/xRegExp
      /xErrObject/xFileSystemObject
[3]當要使用對應的對象時，統(tǒng)一通過O.XXX的形式來引用，尤其是對象名很長時。
[4]雖然只需要一個這樣的對象，但是還是建議使用類模塊，而非標準模塊，這是為了避免命名污染，因為定義太多的標準模塊的全局函數，會將命名
      弄得一團糟，有時會出現相互遮蔽的現象；而且如TypeName這種VBA標準中已使用了的命名，如果在標準模塊中重定義了，那么它會被遮蔽，造
      成功能混亂，明明想調用VBA.TypeName卻調用了某標準模塊的自定義TypeName成員
8.定義一系列的Tool_XXX類模塊，用于對支持VBA的文件進行功能擴展
[1]比如.doc/.xls/.mdb/.dwg/.ppt，則可對應的定義Tool_DOC/Tool_XLS/Tool_MDB/Tool_DWG/Tool_PPT類模塊，來封裝對Word/Excel/Access
      /AutoCAD/PowerPoint文件的功能代碼的設計。
[2]仍然只在O模塊中定義一個這些類型的全局對象，并分別命名為tDOC/tXLS/tMDB/tDWG/tPPT，方便訪問
[3]Property Get/Set App屬性：用于定義對應的VBA宿主對象，即Application對象，根據O.VBAType屬性來決定是新建對象，還是直接引用現成對象，
      比如你要調用O.tXLS.App屬性，而當前文檔是一個Word文檔，那么對其進行訪問，就需要新建Application對象，而如果本來就是Excel文檔，就
      可以直接設置為當前的Application對象
[4]Property Get/Set Doc屬性：用于定義對應的文檔對象，Word的是Document類型，Excel的是Workbook，……
[5]其它的功能代碼
9.定義一個命名為TXTData的標準模塊，來存放本VBA工程的工程數據，比如上面的O.NextErrorNumber的數據，以XML文本的形式保存，你可以借用ThsiWorkbook.VBProject.VBComponent.CodeModule.Lines()/AddFromString()/ReplaceLine()/InsertLines()/DeleteLines() 等API來完成數據的讀寫
10.定義一個命名為Checker的類模塊，用來存放本VBA工程中所有的通用的判斷式API
[1]返回值總是Boolean，成員建議命名為IsXXX形式，仍然只在全局定義一個這樣的對象實例，命名為Chk，可能經常要用到的功能如下
[2]IsAllInType(Obj As Object,Byval TypeName As String)方法：檢查如數組/集合這種包含很多元素的對象的每一個元素類型是否是某類型
[3]IsAllInTypes(Obj As Object,ParamArray TypeNames() As Variant)方法：檢查如數組/集合這種包含很多元素的對象的每一個元素類型是否是某幾個
      類型中的一個
[4]IsInTypes(Obj As Object, ParamArray TypeNames() As Variant)方法：用于檢查某個變量，是否是某幾個類型中的一個
[5]HasAttr(Obj As Object, Byval ProcName As String)方法：用于檢驗某對象是否存在某成員
[6]IsAllTrue(ParamArray Values() As Variant)方法：用于檢驗某些變量，是否全為True，如果只傳遞一個變量，將把該變量當作一個多元素變量，并對
      其所有元素執(zhí)行該操作
[8]IsAnyTrue(ParamArray Values() As Variant)方法：用于檢驗某些變量，是否存有一個為True，如果只傳遞一個變量，將把該變量當作一個多元素變
      量，并對其所有元素執(zhí)行該操作
[9]IsSubSet(Items1 As Variant, Items2 As Variant)方法：用于檢驗前者是否是后者的子集
[10]IsIn(Item As Variant, ParamArray Items() As Variant)方法：用于檢驗前者是否是后者中的一項，如果只傳遞一個變量，將把該變量當作一個多元素
      變量，并在該變量的元素中檢驗Item是否是其中之一
11.定義一個命名為Createor的類模塊，封裝所有的NewXXX操作，方便初始化對象
[1]仍然只在全局定義一個這樣的對象實例，全局變量名為Crt
[2]實現某些標準或者第三方的類型對象的實例化，及初始化，比如新建一個ErrObject對象
[3]實現某些第二方類型（就是你自己的自定義類型）對象的實例化，及初始化，比如某些Type結構體，或者某些自定義類
12.定義一個命名為Convertor的類模塊，封裝所有的轉化操作
[1]仍然只在全局定義一個這樣的對象實例，全局變量名為Cvt
[2]各種對象的字符串格式化方法，命名為str_+TypeName，方便對對象的格式化
13.定義一個命名為Caller的類模塊，封裝所有的集群調用，能一定程度上實現函數式編程，封裝好了，可以減少使用循環(huán)語句
[1]仍然只在全局定義一個這樣的對象實例，全局變量名為Cal
[2]ForEach(Objs As Variant, ByVal ProcName As String, ByVal CallType As VbCallType, ParamArray Args() As Variant)方法：對Objs中每一個對象訪問對
      應的成員
[3]Filtrate(Objs As Variant, ByVal ProcName As String, ByVal CallType As VbCallType,  CompareTo As Variant, ByVal GetWhenEqual As Boolean,  _
      ParamArray Args() As Variant)方法：從Objs對象集中篩選對象
14.定義一個命名為Dialogs的類模塊，用于封裝可能用到的對話框
[1]仍然只在全局定義一個這樣的對象實例，全局變量名為Dlgs
[2]GetColor(Optional dlgTitle As String)方法：調用MSComDlg庫的功能，實現顏色的選取
[3]GetFont(Optional Min As Integer = -1, Optional Max As Integer = -1,  Optional dlgTitle As String) As Nutix.MSComDlgFont方法：調用MSComDlg庫的
      功能，實現對字體的設置，其中Nutix.MSComDlgFont為自定義的Type結構體類型，因為你是沒辦法直接New出一個Font對象的
[4]GetSaveFileName(Optional Filter As String = "所有多件 (*.*)",  Optional FilterIndex As Integer = 1, Optional DefaultExt As String, _
      Optional InitDir As String, Optional dlgTitle As String)方法：調用MSComDlg庫的功能，獲取要保存的文件名與路徑
[5]GetOpenFileName(Optional Filter As String = "所有多件 (*.*)",  Optional FilterIndex As Integer = 1, Optional DefaultExt As String, _
      Optional MultiSelect As Boolean = False, Optional InitDir As String,  Optional dlgTitle As String)方法：調用MSComDlg庫的功能，獲取要打開的文件名
      與路徑
15.定義一個命名為System的類型模塊，用于對封裝本操作系統(tǒng)的功能操作
[1] 仍然只在全局定義一個這樣的對象實例，全局變量名為Sys
[2]HasTaskNamed(ByVal Name As String)方法：調用WbemScripting庫（WMI）的相關功能，檢驗操作系統(tǒng)上是否已經運行了某名稱的進程
[3]GetClipText()方法：調用MSForms.DataObject的功能，實現對系統(tǒng)剪貼板的文本的讀取
[4]SetClipText()方法：調用MSForms.DataObject的功能，實現對系統(tǒng)剪貼板的內容進行設置

16.定義一個命名為VBS/JS的類模塊，用于封裝對VBS/JS代碼的調用，借助MSScriptControl庫來實現
[1]仍然只在全局定義一個這樣的對象實例，全局變量名為VBS/JS
[2]代碼保存在上面所說的本VBA工程的數據模塊，即TXTData模塊中
[3]Property Get This() As MSScriptControl屬性：用于向外公開內部的中心對象，因為所有功能是構建在MSScriptControl對象上的，故如此說
[4]AddCode(Byval Code As String)方法：用于向This中添加代碼，代碼數據也會被同步存入TXTData模塊中
17.定義一個命名為Output的類模塊，用于封裝常用的各種字符串格式化操作
[1]仍然只在全局定義一個這樣的對象實例，全局變量名為Out
[2]WriteLine(Byval Line As String)方法：定義當前類的寫操作，所有其它寫操作是基于這個方法的；內部提供向立即窗口/文本文件兩種方向的寫操作
[3]SingleSepLine(Optional Length As Integer)方法：輸出指定長度的“-”（減號），即輸出一個單分割線
[4]DoubleSepLine(Optional Length As Integer)方法：輸出指定長度的“=”（等號），即輸出一個雙分割線
[5]NamedSepLine(ByVal Name As String, Optional ByVal Char As String = "*", Optional Length As Integer)方法：輸出一個命名居中的，指定長度的，
      由Char字符串構成的行
[6]FileName屬性：用于改變輸出方向到一個文本文件
[7]ObjectName屬性：用于定義對象輸出時的對象名，與下面聯合完成對象格式化
[8]PObjSelf(Obj As Variant)方法：用于輸出對象本身，對象名由7定義，輸出形式是：ObjectName + " = " +Object的字符串
[9]PObjCall(Obj As Object, ByVal ProcName As String, ByVal CallType As VBA.VbCallType, ParamArray Args() As Variant)方法：用于輸出對象的某個
      成員，輸出形式是：ObjectName + "." + ProcName + " = " + Object.Proc的值
[10]PObjProperties(Obj As Object, ParamArray ProcNames() As Variant)方法：用于輸出對象的多個屬性，輸出形式如上，每一個屬性，對應一個等式
      輸出行
[11]PTypeValue(Obj As Variant)方法：輸出變量的類型和值，輸出形式：ObjTypeName + " => " + ObjValue的字符串
18.定義命名為frmXXXTool的系列窗體模塊，封裝對各種支持VBA的文件的有界面操作
[1]對應于.doc/.xls/.mdb/.dwg/.ppt，窗體模塊的命名分別為frmDOCTool/frmXLSTool/frmMDBTool/frmDWGTool/frmPPTTool
[2]不用定義全局以上窗體對象，因為VBA系統(tǒng)默認已經創(chuàng)建了一個這樣的對象，其命名與窗體模塊名相同
19.定義命名為Coder的類模塊，用于封裝對本VBA工程的對象編碼功能
[1]仍然只在全局定義一個這樣的對象實例，全局變量名為Cod
[2]引用管理功能
[3]代碼統(tǒng)計功能
[4]代碼增刪替換的功能
[5]基于固定模式的動態(tài)編程功能

20.最后加一段代碼，作為Main模塊的主要工作代碼塊【主要是預先聲明了大量的可能用到的變量和數組，避免每次重新聲明】

Public Sub AAA_00000000_AAA()
''[VBA]數據類型變量聲明
Dim Byt As Byte, Byt1 As Byte, Byt2 As Byte, Byt3 As Byte
Dim Bln As Boolean, Bln1 As Boolean, Bln2 As Boolean, Bln3 As Boolean
Dim Itg As Integer, Itg1 As Integer, Itg2 As Integer, Itg3 As Integer
Dim Lng As Long, Lng1 As Long, Lng2 As Long, Lng3 As Long
Dim Sng As Single, Sng1 As Single, Sng2 As Single, Sng3 As Single
Dim Dbl As Double, Dbl1 As Double, Dbl2 As Double, Dbl3 As Double
Dim Str As String, str1 As String, str2 As String, Str3 As String
Dim Dt As Date, Dt1 As Date, Dt2 As Date, Dt3 As Date
Dim Var As Variant, Var1 As Variant, Var2 As Variant, Var3 As Variant
Dim Obj As Object, Obj1 As Object, Obj2 As Object, Obj3 As Object
ReDim byts(0) As Byte, blns(0) As Boolean, itgs(0) As Integer, lngs(0) As Long
ReDim sngs(0) As Single, dbls(0) As Double, Strs(0) As String
ReDim Dts(0) As Date, Vars(0) As Variant, Objs(0) As Object
Dim i As Long, j As Long, k As Long, RE As New VBScript_RegExp_55.RegExp
Dim c As New Collection, c1 As New Collection, c2 As New Collection, c3 As New Collection
''[Scripting]數據類型變量聲明
Dim d As New Scripting.Dictionary, d1 As New Scripting.Dictionary, d2 As New Scripting.Dictionary
Dim Key As Variant, Key1 As Variant, Key2 As Variant
''[VBScript_RegExp_55]數據類型變量聲明
Dim m As VBScript_RegExp_55.Match, ms As VBScript_RegExp_55.MatchCollection
''[VBIDE]數據類型變量聲明
Dim vbc As vbide.VBComponent, cp As vbide.CodePane, cm As vbide.CodeModule
''[Excel]數據類型變量聲明
Dim rng As Excel.Range, rng1 As Excel.Range, rng2 As Excel.Range, rng3 As Excel.Range
Dim sht As Excel.Worksheet, sht1 As Excel.Worksheet, sht2 As Excel.Worksheet, sht3 As Excel.Range
Dim wb As Excel.Workbook, wb1 As Excel.Workbook, wb2 As Excel.Workbook, wb3 As Excel.Workbook
Dim shp As Excel.Shape, Ole As Excel.OLEObject
''[Word]數據類型變量聲明
Dim Doc As New MSXML2.DOMDocument60, e As MSXML2.IXMLDOMElement, a As MSXML2.IXMLDOMAttribute
''[MSXML2]數據類型變量聲明
Dim CData As MSXML2.IXMLDOMCDATASection, NL As MSXML2.IXMLDOMNodeList, N As MSXML2.IXMLDOMNode
''MSForms相關變量聲明
Dim win As MSForms.UserForm, grp As MSForms.Frame
Dim ctls As MSForms.Control, ctl As MSForms.Control
Dim btn As MSForms.CommandButton, rbtn As MSForms.OptionButton
Dim sbtn As MSForms.SpinButton, tbtn As MSForms.ToggleButton
Dim cbb As MSForms.ComboBox, lst As MSForms.ListBox
Dim ckb As MSForms.CheckBox, img As MSForms.Image
Dim lbl As MSForms.Label, txt As MSForms.TextBox
Dim mp As MSForms.MultiPage, pg As MSForms.Page
Dim ts As MSForms.TabStrip, tb As MSForms.Tab
Dim scb As MSForms.ScrollBar
''<AAA_00000000_AAA_WorkingCode>
''</AAA_00000000_AAA_WorkingCode>
End Sub

復制代碼

================================================================================
如上是我的VBA工程——“VBA工具集.xlsm"的編碼規(guī)劃，共享于此，希望能夠給予各位愛好VBA的壇友以幫助。
如果覺得我的規(guī)劃有功能性劃分或組織不合理的地方，請給出您的建議。

關于各數據類型的Array的初始化寫很多語句是不是很煩人，定義X_Array類如下成員

本帖最后由 wrove 于 2017-7-19 08:34 編輯

Public Function NewBooleans(ParamArray Values() As Variant) As Boolean()
Dim blns() As Boolean, Value As Variant
ReDim blns(0)
For Each Value In Values
blns(UBound(blns)) = Value
ReDim Preserve blns(UBound(blns) + 1)
Next
If UBound(blns) <> 0 Then
ReDim Preserve blns(UBound(blns) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewBooleans", "至少應有一個數據"
End If
NewBooleans = blns
End Function
Public Function NewBooleansInLength(ByVal Length As Long, ParamArray Values() As Variant) As Boolean()
Dim blns() As Boolean, Value As Variant, lNow As Long
ReDim blns(0)
For Each Value In Values
blns(UBound(blns)) = Value
ReDim Preserve blns(UBound(blns) + 1)
Next
If UBound(blns) <> 0 Then
lNow = UBound(blns) - LBound(blns) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewBooleansInLength", "太多數據"
Case Is < Length
ReDim Preserve blns(Length)
End Select
End If
NewBooleansInLength = blns
End Function
Public Function NewBytes(ParamArray Values() As Variant) As Byte()
Dim byts() As Byte, Value As Variant
ReDim byts(0)
For Each Value In Values
byts(UBound(byts)) = Value
ReDim Preserve byts(UBound(byts) + 1)
Next
If UBound(byts) <> 0 Then
ReDim Preserve byts(UBound(byts) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewBytes", "至少應有一個數據"
End If
NewBytes = byts
End Function
Public Function NewBytesInLength(ByVal Length As Long, ParamArray Values() As Variant) As Byte()
Dim byts() As Byte, Value As Variant, lNow As Long
ReDim byts(0)
For Each Value In Values
byts(UBound(byts)) = Value
ReDim Preserve byts(UBound(byts) + 1)
Next
If UBound(byts) <> 0 Then
lNow = UBound(byts) - LBound(byts) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewBytesInLength", "太多數據"
Case Is < Length
ReDim Preserve byts(Length)
End Select
End If
NewBytesInLength = byts
End Function
Public Function NewDates(ParamArray Values() As Variant) As Date()
Dim Dts() As Date, Value As Variant
ReDim Dts(0)
For Each Value In Values
Dts(UBound(Dts)) = Value
ReDim Preserve Dts(UBound(Dts) + 1)
Next
If UBound(Dts) <> 0 Then
ReDim Preserve Dts(UBound(Dts) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewDates", "至少應有一個數據"
End If
NewDates = Dts
End Function
Public Function NewDatesInLength(ByVal Length As Long, ParamArray Values() As Variant) As Date()
Dim Dts() As Date, Value As Variant, lNow As Long
ReDim Dts(0)
For Each Value In Values
Dts(UBound(Dts)) = Value
ReDim Preserve Dts(UBound(Dts) + 1)
Next
If UBound(Dts) <> 0 Then
lNow = UBound(Dts) - LBound(Dts) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewDatesInLength", "太多數據"
Case Is < Length
ReDim Preserve Dts(Length)
End Select
End If
NewDatesInLength = Dts
End Function
Public Function NewDoubles(ParamArray Values() As Variant) As Double()
Dim dbls() As Double, Value As Variant
ReDim dbls(0)
For Each Value In Values
dbls(UBound(dbls)) = Value
ReDim Preserve dbls(UBound(dbls) + 1)
Next
If UBound(dbls) <> 0 Then
ReDim Preserve dbls(UBound(dbls) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewDoubles", "至少應有一個數據"
End If
NewDoubles = dbls
End Function
Public Function NewDoublesInLength(ByVal Length As Long, ParamArray Values() As Variant) As Double()
Dim dbls() As Double, Value As Variant, lNow As Long
ReDim dbls(0)
For Each Value In Values
dbls(UBound(dbls)) = Value
ReDim Preserve dbls(UBound(dbls) + 1)
Next
If UBound(dbls) <> 0 Then
lNow = UBound(dbls) - LBound(dbls) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewDoublesInLength", "太多數據"
Case Is < Length
ReDim Preserve dbls(Length)
End Select
End If
NewDoublesInLength = dbls
End Function
Public Function NewIntegers(ParamArray Values() As Variant) As Integer()
Dim itgs() As Integer, Value As Variant
ReDim itgs(0)
For Each Value In Values
itgs(UBound(itgs)) = Value
ReDim Preserve itgs(UBound(itgs) + 1)
Next
If UBound(itgs) <> 0 Then
ReDim Preserve itgs(UBound(itgs) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewIntegers", "至少應有一個數據"
End If
NewIntegers = itgs
End Function
Public Function NewIntegersInLength(ByVal Length As Long, ParamArray Values() As Variant) As Integer()
Dim itgs() As Integer, Value As Variant, lNow As Long
ReDim itgs(0)
For Each Value In Values
itgs(UBound(itgs)) = Value
ReDim Preserve itgs(UBound(itgs) + 1)
Next
If UBound(itgs) <> 0 Then
lNow = UBound(itgs) - LBound(itgs) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewIntegersInLength", "太多數據"
Case Is < Length
ReDim Preserve itgs(Length)
End Select
End If
NewIntegersInLength = itgs
End Function
Public Function NewLongs(ParamArray Values() As Variant) As Long()
Dim lngs() As Long, Value As Variant
ReDim lngs(0)
For Each Value In Values
lngs(UBound(lngs)) = Value
ReDim Preserve lngs(UBound(lngs) + 1)
Next
If UBound(lngs) <> 0 Then
ReDim Preserve lngs(UBound(lngs) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewLongs", "至少應有一個數據"
End If
NewLongs = lngs
End Function
Public Function NewLongsInLength(ByVal Length As Long, ParamArray Values() As Variant) As Long()
Dim lngs() As Long, Value As Variant, lNow As Long
ReDim lngs(0)
For Each Value In Values
lngs(UBound(lngs)) = Value
ReDim Preserve lngs(UBound(lngs) + 1)
Next
If UBound(lngs) <> 0 Then
lNow = UBound(lngs) - LBound(lngs) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewLongsInLength", "太多數據"
Case Is < Length
ReDim Preserve lngs(Length)
End Select
End If
NewLongsInLength = lngs
End Function
Public Function NewSingles(ParamArray Values() As Variant) As Single()
Dim sngs() As Single, Value As Variant
ReDim sngs(0)
For Each Value In Values
sngs(UBound(sngs)) = Value
ReDim Preserve sngs(UBound(sngs) + 1)
Next
If UBound(sngs) <> 0 Then
ReDim Preserve sngs(UBound(sngs) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewSingles", "至少應有一個數據"
End If
NewSingles = sngs
End Function
Public Function NewSinglesInLength(ByVal Length As Long, ParamArray Values() As Variant) As Single()
Dim sngs() As Single, Value As Variant, lNow As Long
ReDim sngs(0)
For Each Value In Values
sngs(UBound(sngs)) = Value
ReDim Preserve sngs(UBound(sngs) + 1)
Next
If UBound(sngs) <> 0 Then
lNow = UBound(sngs) - LBound(sngs) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewSinglesInLength", "太多數據"
Case Is < Length
ReDim Preserve sngs(Length)
End Select
End If
NewSinglesInLength = sngs
End Function
Public Function NewStrings(ParamArray Values() As Variant) As String()
Dim Strs() As String, Value As Variant
ReDim Strs(0)
For Each Value In Values
Strs(UBound(Strs)) = Value
ReDim Preserve Strs(UBound(Strs) + 1)
Next
If UBound(Strs) <> 0 Then
ReDim Preserve Strs(UBound(Strs) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewStrings", "至少應有一個數據"
End If
NewStrings = Strs
End Function
Public Function NewStringsInLength(ByVal Length As Long, ParamArray Values() As Variant) As String()
Dim Strs() As String, Value As Variant, lNow As Long
ReDim Strs(0)
For Each Value In Values
Strs(UBound(Strs)) = Value
ReDim Preserve Strs(UBound(Strs) + 1)
Next
If UBound(Strs) <> 0 Then
lNow = UBound(Strs) - LBound(Strs) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewStringsInLength", "太多數據"
Case Is < Length
ReDim Preserve Strs(Length)
End Select
End If
NewStringsInLength = Strs
End Function

復制代碼

Public Function NewVariants(ParamArray Values() As Variant) As Variant()
Dim Vars() As Variant, Value As Variant
ReDim Vars(0)
For Each Value In Values
Vars(UBound(Vars)) = Value
ReDim Preserve Vars(UBound(Vars) + 1)
Next
If UBound(Vars) <> 0 Then
ReDim Preserve Vars(UBound(Vars) - 1)
Else
Err.Raise -2147221322, "Nutix.X_Array.NewVariants", "至少應有一個數據"
End If
NewVariants = Vars
End Function
Public Function NewVariantsInLength(ByVal Length As Long, ParamArray Values() As Variant) As Variant()
Dim Vars() As Variant, Value As Variant, lNow As Long
ReDim Vars(0)
For Each Value In Values
Vars(UBound(Vars)) = Value
ReDim Preserve Vars(UBound(Vars) + 1)
Next
If UBound(Vars) <> 0 Then
lNow = UBound(Vars) - LBound(Vars) + 1
Select Case lNow
Case Is = Length
''Already Exists, Do Nothing
Case Is > Length
Err.Raise -2147221323, "Nutix.X_Array.NewVariantsInLength", "太多數據"
Case Is < Length
ReDim Preserve Vars(Length)
End Select
End If
NewVariantsInLength = Vars
End Function