我正在使用Visio-2016 VBA。 在我的主模块中，我必须在每个Visio页面上绘制大约十个矩形。在For循环中迭代32页。还需要为每个矩形设置矩形的各种属性，例如“边框”或“无边框”。
DrawRectangle（）函数需要具有X1，Y1，X2，Y2形式的矩形坐标对 我的值在Double（双精度浮点数）常量中。
我已尽力将这些坐标对存储和分组为常量，但无济于事。
一个矩形的样本坐标对为：
X1 = 3.179133858
Y1 = 1.181102362
X2 = 6.131889764
Y2 = 1.57480315
我尝试了以下操作，将至少十个矩形的坐标对分组，但没有成功： -Main子句顶部的常量列表（不需要） -枚举列表（仅适用于Long数据类型） -数组或二维数组（不方便，仅通过数组索引设置/返回值） -类型...结束类型（可以，但是在创建收藏夹/词典时出错）
这是我尝试创建的类的一部分代码
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子菜单中设置Class属性并在迭代中调用方法以根据需要创建矩形形状，而我的Main Module仍将保持整洁干净
最后一个补充问题： 任何内在（内置VBA）数据类型的常量是否与该数据类型的变量具有相同的内存使用量？
答案 0 :(得分：2)
你是如此亲密。解决此问题的一种方法是使用Create / Self方法创建用于实例化对象的矩形类
这是矩形类
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
通过上面的sub，您现在可以了解为什么我们不希望Draw Sub带有参数，这意味着我们在这里失去了代码的简单性。
最后一步是设置Rectangle类的预先声明的属性。您可以通过将类导出到Notepad ++并将属性设置为treu并重新导入来实现。或使用Fantabulous RubberDuck插件提供的'@PredeclaredId属性。
如果被卡住，请回到这里。
上面的代码可以完善很多，但我希望您现在能够看到前进的方向。