测试 Visio 区段、行、列的最大许可号

uhnmki

这是个副产品。Visio 帮助中没提到上限是多少（下限它说的也不对），就用试探的方法，试试上限到底是多少。
运行环境：WinXPsp3 + OfficeXP + Visio 2002。
先手动试，注意，一定要事先选择一个图形，才能使用程序，

1. 
   
2. '方法一、手动调 S、R、C ，如发生：运行时错误 '-2032465765 (86db089b)': 不能创建对象。则下调 S、R、C 数值。由高位数万、千、……一直试到个位。
   
3. Sub Exploring_MaxNum_Index_Of_Sec_Row_Col_v01()
   
4.     Dim shpObj As Shape
   
5.     Set shpObj = ActiveWindow.Selection(1)
   
6. Manually_Tunning:
   
7.     Dim shpcelObj As Cell
   
8.     Set shpcelObj = shpObj.CellsSRC(254, 32767, 254)    '可调节 S、R、C Index 试错
   
9.     Dim fExistsLocally As Boolean
   
10.     fExistsLocally = True
    
11. Debug_Print:
    
12.     With shpcelObj
    
13.         Debug.Print "------- test_valid_secIndex_rowIndex_colIndex -------"
    
14.         Debug.Print "CellsSRC("; .Section; ","; .Row; ","; .Column; ")"; ".Name : "; .Name
    
15.         Debug.Print Tab(17); ".IsInherited : "; CBool(.IsInherited)
    
16.         Debug.Print "Shape.CellsSRCExists("; .Section; ","; .Row; ","; .Column; ","; fExistsLocally; ") = "; CBool(shpObj.CellsSRCExists(.Section, .Row, .Column, fExistsLocally))
    
17.     End With
    
18. End Sub
    
19. 
    

复制代码

得到：MaxSecNum: 254   ；  MaxRowNum: 32767    ；   MaxColNum: 254。
手动的太累，弄点高大上的，于是：

1. 
   
2. '方法二、自动找寻 S、R、C 上限，DO……Loop 循环，一直到运行时错，记下循环数。
   
3. Sub Exploring_MaxNum_Index_Of_Sec_Row_Col_v02()
   
4.     Dim secIndex As Long, rowIndex As Long, colIndex As Long
   
5. AutoExploring_1:    '都记录到 cellName 变量中，但太大死机，根本运行不下去，宕机，弃之
   
6.     secIndex = 1
   
7.     rowIndex = 1
   
8.     colIndex = 0
   
9.    
   
10.     Dim shpObj As Shape
    
11.     Set shpObj = ActiveWindow.Selection(1)
    
12.     Dim testStr As String
    
13.     Dim CellName As String
    
14. With shpObj
    
15. On Error Resume Next
    
16.     Do    '寻找 column Index 最大值
    
17.         testStr = .CellsSRC(secIndex, rowIndex, colIndex).Name
    
18.         If Err.Number = 0 Then
    
19.             CellName = "CellsSRC(" & secIndex & "," & rowIndex & "," & colIndex & ").Name: " & .CellsSRC(secIndex, rowIndex, colIndex).Name & vbCrLf
    
20.             colIndex = colIndex + 1
    
21.         Else
    
22.             Err.Clear
    
23.             LoopOver = True
    
24.             MaxCol = colIndex - 1
    
25.             colIndex = colIndex - 1
    
26.         End If
    
27.     Loop Until LoopOver = True
    
28.     LoopOver = False
    
29.    
    
30.     Do    '寻找 row Index 最大值
    
31.         testStr = .CellsSRC(secIndex, rowIndex, colIndex).Name
    
32.         If Err.Number = 0 Then
    
33.             CellName = "CellsSRC(" & secIndex & "," & rowIndex & "," & colIndex & ").Name" & .CellsSRC(secIndex, rowIndex, colIndex).Name & vbCrLf
    
34.             rowIndex = rowIndex + 1
    
35.         Else
    
36.             Err.Clear
    
37.             LoopOver = True
    
38.             MaxRow = rowIndex - 1
    
39.             rowIndex = rowIndex - 1
    
40.         End If
    
41.     Loop Until LoopOver = True
    
42.     LoopOver = False
    
43.    
    
44.     Do    '寻找 section Index 最大值
    
45.         testStr = .CellsSRC(secIndex, rowIndex, colIndex).Name
    
46.         If Err.Number = 0 Then
    
47.             CellName = "CellsSRC(" & secIndex & "," & rowIndex & "," & colIndex & ").Name" & .CellsSRC(secIndex, rowIndex, colIndex).Name & vbCrLf
    
48.             secIndex = secIndex + 1
    
49.         Else
    
50.             Err.Clear
    
51.             LoopOver = True
    
52.             MaxSec = secIndex - 1
    
53.             secIndex = secIndex - 1
    
54.         End If
    
55.     Loop Until LoopOver = True
    
56. On Error GoTo 0
    
57.    
    
58.     '输出到文本文件，与Visio文档同名的.txt
    
59.     Open StrReverse(Replace(StrReverse(ThisDocument.Path & ThisDocument.Name), ".", "_", Count:=1)) & ".txt" For Output As #2
    
60.     Print #2, CellName
    
61.     Print #2, "Max Section Number:"; MaxSec; Tab(28); "Max Row Number:"; MaxRow; Tab(50); "Max Column Number:"; MaxCol
    
62. End With
    
63.    
    
64.     Close #2
    
65. End Sub

复制代码

附件为 ver 0.3 版的作法。
调查Visio区段号、行号、列号的最大可取值.zip (351.38 KB, 下载次数: 4)

2014-5-30 11:53 上传

点击文件名下载附件
用VBA调查Visio图形的区段号行号列号的最大值

天可怜见，给点分啦、鲜花啦、掌声啦，能换点权、利的都行，请不吝赐之，多多益善。