我正在使用Visio-2016 VBA。在我的主模块中，我必须为每个Visio页面绘制大约十个矩形形状。在For循环中迭代32页。还需要为每个矩形设置矩形的各种属性，例如Border或borderless。
DrawRectangle（）函数需要以X1，Y1，X2，Y2的形式具有矩形的坐标对。我的值在Double（双精度浮点）CONSTANTS中。
我尽力存储和分组这些坐标对作为常数，但无济于事。
一个矩形形状的样本坐标对是：
X1 = 3.179133858
Y1 = 1.181102362
X2 = 6.131889764
O = 1.57480315
我尝试按照以下方法对至少十个矩形的坐标组进行分组，但没有成功： - Main子顶部常量的简单列表（不需要它） - 枚举列表（仅适用于长数据类型） - 数组或二维数组（不方便，仅通过数组索引设置/返回val） - 类型...结束类型（工作但创建集合/字典时出错）
这是我尝试创建的类的一部分代码
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 ......
' ///////////////////////////////////////////
我也尝试在上面的代码中用Collection替换Collection和相同的编译器错误
我想在Class模块中存储所有坐标对数据，最好是常量（如果不可能在变量中）。从Main sub，我将设置Class属性并在迭代中调用方法以根据需要创建矩形形状，然后我的主模块仍然整洁干净
最后一个补充问题：任何内在（内置VBA）数据类型的常量是否与该数据类型的变量具有相同的内存使用量？
你是如此亲密。解决此问题的一种方法是使用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
有了上面的子，你现在可以看到为什么我们不希望我们的Draw Sub采用参数，这意味着我们在这里失去了代码的简单性。
最后一步是设置Rectangle类的预先声明的属性。您可以通过将类导出到Notepad ++来将属性设置为treu并重新导入来完成此操作。或者使用Fantabulous RubberDuck插件提供的'@PredeclaredId属性。
如果你遇到困难，请回到这里。
上面的代码可以更加完善，但我希望你现在能够看到前进的方向。