VBA类具有属性的属性
我试图build立一个基本上描述一个地理空间条件语句的类，其中一个参数是高度。 海拔高度有4个属性，如最小，最大，单位，反转，我试图使类支持2层属性。
IE
Dim blah as qClass Set blah = New qClass blah.Altitude.Min = 100 这是我正在寻找的效果，但我很难搞清楚如何实现它。 （中等VBA经验，但第一次进入课堂）
我的解决scheme：我做了一个generics类，它具有我将用于每个参数的最小/最大/单位/反转参数，所以只需要设置一次，然后重用。
设置类
Private pMin As Integer Private pMax As Integer Private pUnit As String Private pInvert As Boolean Public Property Get Min() As Integer Min = pMin End Property Public Property Get Max() As Integer Max = pMax End Property Public Property Get Unit() As String Unit = pUnit End Property Public Property Get Invert() As Boolean Invert = pInvert End Property Public Property Let Min(Value As Integer) pMin = Value End Property Public Property Let Max(Value As Integer) pMax = Value End Property Public Property Let Unit(Value As String) pUnit = Value End Property Public Property Let Invert(Value As Boolean) pInvert = Value End Property
父类设置使用
'CPA Range Property Public Property Get CPARange() As cSettings If pCPARange Is Nothing Then Set pCPARange = New cSettings Set CPARange = pCPARange End Property Public Property Set CPARange(Value As cSettings) Set pCPARange = Value End Property
如果你想这样做：
Public Sub Test() Dim a As New aClass a.InitializeFromValues 40, 150 Dim q As New qClass q.Altitude = a ' q.Altitude.Min = 40 ' q.Altitude.Max = 150 Dim z As New qClass z.Altitude.Max = 100 ' z.Altitude.Min = 0 (default) ' z.Altitude.Max = 100 End Sub
你需要两个class。 我称他们为qClass和aClass 。
=== aClass定义===
Private m_min As Double Private m_max As Double Private Sub Class_Initialize() m_min = 0# m_max = 0# End Sub Public Sub InitializeFromValues(ByVal Min As Double, ByVal Max As Double) m_min = Min m_max = Max End Sub Public Property Get Min() As Double Min = m_min End Property Public Property Let Min(ByVal X As Double) m_min = X End Property Public Property Get Max() As Double Max = m_max End Property Public Property Let Max(ByVal X As Double) m_max = X End Property
和
=== qClass定义===
Private m_alt As aClass Private Sub Class_Initialize() Set m_alt = New aClass End Sub Public Sub InitializeFromValues(ByVal alt As aClass) Set m_alt = alt End Sub Private Sub Class_Terminate() Set m_alt = Nothing End Sub Public Property Get Altitude() As aClass Set Altitude = m_alt End Property Public Property Set Altitude(ByVal X As aClass) Set m_alt = X End Property
其实，我会用一个例子来扩充我的评论。 我有两个自定义类：clsComputer和clsHDD。 clsComputer有3个属性：pModel，pSerialNumber和pHDD。 pHDD是clsHDD的实例（因为计算机可以有多个不同的硬盘驱动器）。 真正重要的部分是在clsComputer我们检查If pHardDrives(index) Is Nothing ！ 如果你不这样做，并尝试访问objComputer.HDD.Status它会崩溃。
clsComputer：
Private pModel As String Private pSerialNumber As String '''''''''''''''''''''' ' Model property '''''''''''''''''''''' Public Property Get Model() As String Model = pModel End Property Public Property Let Model(value As String) pModel = value End Property '''''''''''''''''''''' ' SerialNumber property '''''''''''''''''''''' Public Property Get SerialNumber() As String SerialNumber = pSerialNumber End Property Public Property Let SerialNumber(value As String) pSerialNumber = value End Property '''''''''''''''''''''' ' HardDrives property '''''''''''''''''''''' Public Property Get HardDrives(index As Integer) As clsHDD If pHardDrives(index) Is Nothing Then Set pHardDrives(index) = New clsHDD Set HardDrives = pHardDrives(index) End Property Public Property Set HardDrives(index As Integer, value As clsHDD) Set pHardDrives(index) = value End Property '''''''''''''''''''''' ' HardDrives property '''''''''''''''''''''' Public Property Get HardDrives(index As Integer) As clsHDD If pHardDrives(index) Is Nothing Then Set pHardDrives(index) = New clsHDD Set HardDrives = pHardDrives(index) End Property Public Property Set HardDrives(index As Integer, value As clsHDD) Set pHardDrives(index) = value End Property
clsHDD：
Private pDescription As String Private pStatus As String Public Property Get Description() As String Description = pDescription End Property Public Property Let Description(value As String) pDescription = value End Property Public Property Get Status() As String Status = pStatus End Property Public Property Let Status(value As String) pStatus = value End Property
因为你似乎只需要属性处理一个地理空间“对象”，那么你可以使用UDT的
你可以在任何模块中声明它如下：
Option Explicit Public Type AltitudeType '<~~ first declare the UDT that will be a sub-type of the main one Min As Long Max As Long Units As String 'my guessing... Invert As Boolean 'my guessing... End Type Public Type GeoSpatial '<~~ then declare the main UDT Altitude As AltitudeType GeoInfo1 As Long ' I don't know anything about geospatials... GeoInfo2 As Double ' I don't know anything about geospatials... GeoInfo3 As String ' I don't know anything about geospatials... End Type
然后在任何其他模块中使用它，如下所示：
Sub main() Dim GeoSpatials(1 To 10) As GeoSpatial '<~~ initialize the UDT. here I assumed you would need an array SetDefault GeoSpatials '<~~ launch default setting... GeoSpatials(1).Altitude.Min = 200 '<~~ ... and then define only peculiar properties GeoSpatials(2).GeoInfo1 = 2000000 '<~~ etc... End Sub Sub SetDefault(geospatArray() As GeoSpatial) '<~~ Sub to initialize each element of the geospatial array Dim i As Long For i = LBound(geospatArray) To UBound(geospatArray) With geospatArray(i) With .Altitude .Min = 100 .Max = 200 .Units = "Meters" .Invert = True End With .GeoInfo1 = 1000000 .GeoInfo2 = 100.2 .GeoInfo3 = "Geospat" End With Next i End Sub