如何在 VBA 中存储/分组/操作浮点常量
How to Store / Groups together / manipulate Floating point Constants in VBA
我正在使用 Visio-2016 VBA。
在我的主模块中，我必须为每个 Visio 页面绘制大约十个矩形形状。在一个 For 循环中迭代 32 个页面。还需要为每个矩形设置各种矩形属性，例如边框或无边框。
DrawRectangle()函数需要X1,Y1,X2,Y2形式的矩形坐标对
我的值在 Double(double-precision floating-point) CONSTANTS 中。
我尽力将这些坐标对存储和分组为常量，但无济于事。
一个矩形的样本坐标对是：
X1 = 3.179133858
Y1 = 1.181102362
X2 = 6.131889764
Y2 = 1.57480315
我尝试按照以下方法对至少十个矩形的坐标对进行分组，但没有成功：
- Main sub 顶部的普通常量列表（不想要它）
- 枚举列表（仅适用于 Long 数据类型）
- 数组或二维数组（不方便，set/return val by Array index only）
- 类型 ... 结束类型（有效但创建 collection/dictionary 时出错）
这是我正在尝试创建的 Class 的部分代码
Public Type CoordRectType
X1 As Double
Y1 As Double
X2 As Double
Y2 As Double
End Type
Public RectLftBtm As CoordRectType
Public RectLftTop As CoordRectType
Public colRect As Collection
Sub TestIt()
' Create instances of UDT as required
' LEFT-BOTTOM BarCode [vsoShape1]
RectLftBtm.X1 = 3.179133858
RectLftBtm.Y1 = 1.181102362
RectLftBtm.X2 = 6.131889764
RectLftBtm.Y2 = 1.57480315
' LEFT-TOP BarCode [vsoShape2]
RectLftTop.X1 = 3.179133858
RectLftTop.Y1 = 1.181102362
RectLftTop.X2 = 6.131889764
RectLftTop.Y2 = 1.57480315
colRect.Add RectLftBtm , "LeftBottomRect" ''' Compiler Error here ''''''
colRect.Add RectLftTop , "LeftTopRect" ''' Compiler Error here ''''''
End Sub
''' .... REST OF THE CODE FOR CLASS ......
' ///////////////////////////////////////////
我也尝试在上面的代码中用 Dictionary 替换 Collection 但同样的编译器错误
我想将所有坐标对数据最好存储为 Class 模块中的常量（如果不可能的话，而不是变量）。从 Main sub，然后我将设置 Class 属性并在迭代中调用方法以根据需要创建矩形形状，并且我的 Main 模块仍然整洁干净
最后一个补充问题：
任何内部（内置 VBA）数据类型的常量是否与该数据类型的变量具有相同的内存使用量？
你们太亲密了。解决此问题的一种方法是使用 Create/Self 自实例化对象的方法创建矩形 class
这是矩形class
Option Explicit
Private Type Properties
X1 As Double
X2 As Double
Y1 As Double
Y2 As Double
' extend this pattern to include any other parameters relevant to drawing the rectangle
End Type
Private p As Properties
Public Function Create _
( _
ByVal X1 As Double, _
ByVal Y1 As Double, _
ByVal X2 As Double, _
ByVal Y2 As Double _
) As Rectangle
With New Rectangle
Set Create = .Self(X1, Y1, X2, Y2)
End With
End Function
Public Function Self _
( _
ByVal X1 As Double, _
ByVal Y1 As Double, _
ByVal X2 As Double, _
ByVal Y2 As Double _
) As Rectangle
With p
.X1 = X1
.Y1 = Y1
.X2 = X2
.Y2 = Y2
' extend this pattern to include any other parameters relevant to drawing your rectangle
End With
Set Self = Me
End Function
Public Sub Draw() ' You don't want to provide parameters when you call draw. This should be done
' when you create your rectangle
' Put the code to draw the rectangle here
End Sub
您会注意到我们已经包含了矩形绘制自身的功能。您稍后会明白我们为什么这样做。
现在我们创建矩形页面。所以在一个模块中包含
Public Function SetupPage1() As Collection
' In practise we would probably setup a Page class and register the rectangles with the page class instance
Dim my_rectangles As Collection
Set my_rectangles = New Collection
With my_rectangles
.Add Rectangle.Create(3.179133858, 1.181102362, 6.131889764, 1.57480315)
.Add Rectangle.Create(3.179133858, 1.181102362, 6.131889764, 1.57480315)
' etc
End With
Set SetupPage1 = my_rectangles
End Function
和
Public Function SetupAllPages() As Collection
Dim my_pages As Collection
Set my_pages = New Collection
With my_pages
.Add SetupPage1
.Add SetupPage2
.Add SetupPage3
'etc
End With
Set SetupAllPages = my_pages
End Function
最后，在同一个模块或另一个模块中，在所有页面上绘制矩形的代码。
Public Sub DrawPages()
Dim PagesToDraw As Collection
Dim this_page As Variant
Dim this_rectangle As Variant
Set PagesToDraw = SetupAllPages
For Each this_page In PagesToDraw ' this page takes a collection
For Each this_rectangle In this_page
this_rectangle.Draw
Next
Next
End Sub
有了上面的子你现在可以明白为什么我们不希望我们的 Draw Sub 带参数，这意味着我们失去了这里代码的简单性。
最后一步是设置矩形的预声明属性class。您可以通过将 class 导出到 Notepad++ 并将属性设置为 treu 并重新导入来执行此操作。或者使用 Fantabulous RubberDuck 插件提供的 '@PredeclaredId 属性。
如果遇到困难，请返回此处。
上面的代码可以进一步完善，但我希望您现在能够看到前进的方向。
我正在使用 Visio-2016 VBA。 在我的主模块中，我必须为每个 Visio 页面绘制大约十个矩形形状。在一个 For 循环中迭代 32 个页面。还需要为每个矩形设置各种矩形属性，例如边框或无边框。
DrawRectangle()函数需要X1,Y1,X2,Y2形式的矩形坐标对 我的值在 Double(double-precision floating-point) CONSTANTS 中。
我尽力将这些坐标对存储和分组为常量，但无济于事。
一个矩形的样本坐标对是：
X1 = 3.179133858
Y1 = 1.181102362
X2 = 6.131889764
Y2 = 1.57480315
我尝试按照以下方法对至少十个矩形的坐标对进行分组，但没有成功： - Main sub 顶部的普通常量列表（不想要它） - 枚举列表（仅适用于 Long 数据类型） - 数组或二维数组（不方便，set/return val by Array index only） - 类型 ... 结束类型（有效但创建 collection/dictionary 时出错）
这是我正在尝试创建的 Class 的部分代码
Public Type CoordRectType
X1 As Double
Y1 As Double
X2 As Double
Y2 As Double
End Type
Public RectLftBtm As CoordRectType
Public RectLftTop As CoordRectType
Public colRect As Collection
Sub TestIt()
' Create instances of UDT as required
' LEFT-BOTTOM BarCode [vsoShape1]
RectLftBtm.X1 = 3.179133858
RectLftBtm.Y1 = 1.181102362
RectLftBtm.X2 = 6.131889764
RectLftBtm.Y2 = 1.57480315
' LEFT-TOP BarCode [vsoShape2]
RectLftTop.X1 = 3.179133858
RectLftTop.Y1 = 1.181102362
RectLftTop.X2 = 6.131889764
RectLftTop.Y2 = 1.57480315
colRect.Add RectLftBtm , "LeftBottomRect" ''' Compiler Error here ''''''
colRect.Add RectLftTop , "LeftTopRect" ''' Compiler Error here ''''''
End Sub
''' .... REST OF THE CODE FOR CLASS ......
' ///////////////////////////////////////////
我也尝试在上面的代码中用 Dictionary 替换 Collection 但同样的编译器错误
我想将所有坐标对数据最好存储为 Class 模块中的常量（如果不可能的话，而不是变量）。从 Main sub，然后我将设置 Class 属性并在迭代中调用方法以根据需要创建矩形形状，并且我的 Main 模块仍然整洁干净
最后一个补充问题： 任何内部（内置 VBA）数据类型的常量是否与该数据类型的变量具有相同的内存使用量？
你们太亲密了。解决此问题的一种方法是使用 Create/Self 自实例化对象的方法创建矩形 class
这是矩形class
Option Explicit
Private Type Properties
X1 As Double
X2 As Double
Y1 As Double
Y2 As Double
' extend this pattern to include any other parameters relevant to drawing the rectangle
End Type
Private p As Properties
Public Function Create _
( _
ByVal X1 As Double, _
ByVal Y1 As Double, _
ByVal X2 As Double, _
ByVal Y2 As Double _
) As Rectangle
With New Rectangle
Set Create = .Self(X1, Y1, X2, Y2)
End With
End Function
Public Function Self _
( _
ByVal X1 As Double, _
ByVal Y1 As Double, _
ByVal X2 As Double, _
ByVal Y2 As Double _
) As Rectangle
With p
.X1 = X1
.Y1 = Y1
.X2 = X2
.Y2 = Y2
' extend this pattern to include any other parameters relevant to drawing your rectangle
End With
Set Self = Me
End Function
Public Sub Draw() ' You don't want to provide parameters when you call draw. This should be done
' when you create your rectangle
' Put the code to draw the rectangle here
End Sub
您会注意到我们已经包含了矩形绘制自身的功能。您稍后会明白我们为什么这样做。
现在我们创建矩形页面。所以在一个模块中包含
Public Function SetupPage1() As Collection
' In practise we would probably setup a Page class and register the rectangles with the page class instance
Dim my_rectangles As Collection
Set my_rectangles = New Collection
With my_rectangles
.Add Rectangle.Create(3.179133858, 1.181102362, 6.131889764, 1.57480315)
.Add Rectangle.Create(3.179133858, 1.181102362, 6.131889764, 1.57480315)
' etc
End With
Set SetupPage1 = my_rectangles
End Function
和
Public Function SetupAllPages() As Collection
Dim my_pages As Collection
Set my_pages = New Collection
With my_pages
.Add SetupPage1
.Add SetupPage2
.Add SetupPage3
'etc
End With
Set SetupAllPages = my_pages
End Function
最后，在同一个模块或另一个模块中，在所有页面上绘制矩形的代码。
Public Sub DrawPages()
Dim PagesToDraw As Collection
Dim this_page As Variant
Dim this_rectangle As Variant
Set PagesToDraw = SetupAllPages
For Each this_page In PagesToDraw ' this page takes a collection
For Each this_rectangle In this_page
this_rectangle.Draw
Next
Next
End Sub
有了上面的子你现在可以明白为什么我们不希望我们的 Draw Sub 带参数，这意味着我们失去了这里代码的简单性。
最后一步是设置矩形的预声明属性class。您可以通过将 class 导出到 Notepad++ 并将属性设置为 treu 并重新导入来执行此操作。或者使用 Fantabulous RubberDuck 插件提供的 '@PredeclaredId 属性。
如果遇到困难，请返回此处。
上面的代码可以进一步完善，但我希望您现在能够看到前进的方向。