【新提醒】Excel VBA编程的工程性规划

 本帖最后由 wrove 于 2017-7-18 14:03 编辑

看过很多人写的VBA代码，一团一团的，一点规划都没有，为了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")，方便
        可能需要的动态自动编码
    [7]HasModule(Byval ModuleName As String)函数：检查本工程是否存在某个模块
    [8]Property Get/Let NextErrorNumber：用于规划本工程自定义错误号，使每个错误号都是特有的，自定义错误的抛出如下：

1. ''第二个参数是在设置Err.Source属性，形式为：VBA工程名+模块名+方法/函数/属性名，
   
2. ''如果是属性，属性名后面还建议加一个后缀#Get/#Let/#Set，以示错误的更具体来源
   
3. ''使用“#”而不是“_”，是因为“_”是合法的标识符字符，可能带来含义混淆
   
4. Err.Raise -2147221406, "Nutix.Output.Format", "Values参数包含的值的个数与txt参数中格式化标识个数不相等"

复制代码

    [9]Bake()函数：对本工程进行备份
    [10]Move()函数：将本工程的所有代码迁移到另外一个支持VBA的文件中
    [11]Activate(Byval ModuleName As String)函数：将某模块的代码窗口打开
    [12]各种全局对象的声明，在声明中建议直接带New关键字，这样会避免掉很多Set语句，而且因为New关键字是在对应的对象变量被实际访问时，
          才真正执行对应的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]当要使用对应的对象时，统一通过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，如果只传递一个变量，将把该变量当作一个多元素变量，并对
        其所有元素执行该操作
    [8]IsAnyTrue(ParamArray Values() As Variant)方法：用于检验某些变量，是否存有一个为True，如果只传递一个变量，将把该变量当作一个多元素变
        量，并对其所有元素执行该操作
    [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的类模块，封装所有的集群调用，能一定程度上实现函数式编程，封装好了，可以减少使用循环语句
    [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的类型模块，用于对封装本操作系统的功能操作
    [1] 仍然只在全局定义一个这样的对象实例，全局变量名为Sys
    [2]HasTaskNamed(ByVal Name As String)方法：调用WbemScripting库（WMI）的相关功能，检验操作系统上是否已经运行了某名称的进程
    [3]GetClipText()方法：调用MSForms.DataObject的功能，实现对系统剪贴板的文本的读取
    [4]SetClipText()方法：调用MSForms.DataObject的功能，实现对系统剪贴板的内容进行设置

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系统默认已经创建了一个这样的对象，其命名与窗体模块名相同 19.定义命名为Coder的类模块，用于封装对本VBA工程的对象编码功能     [1]仍然只在全局定义一个这样的对象实例，全局变量名为Cod     [2]引用管理功能     [3]代码统计功能     [4]代码增删替换的功能     [5]基于固定模式的动态编程功能 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"的编码规划，共享于此，希望能够给予各位爱好VBA的坛友以帮助。 如果觉得我的规划有功能性划分或组织不合理的地方，请给出您的建议。

关于各数据类型的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 复制代码 看下面场景： Public Sub AAA()     BBB Split("good hello smile") End Sub Public Sub BBB(Values() As String)     Dim Value     For Each Value In Values         Debug.Print Value     Next End Sub 复制代码 报错如图 如果有上面的API，就可以这样调用，BBB NewStrings("good","hello","smile") C:\Users\nutix\Desktop\捕获.png 捕获.PNG (12.32 KB, 下载次数: 0)