Visio VBA形状按文本值字母序排序及子形状定义问题

一、修复子形状对象定义错误 #

出现Object variable or with variable not set错误，核心原因要么是父形状对象未正确赋值，要么是子形状索引/名称无效。正确的子形状定义方式如下：

可靠的子形状引用示例 #

Dim visPage As Visio.Page
Dim parentShp As Visio.Shape
Dim childShp As Visio.Shape

Set visPage = Visio.ActivePage

' 方式1：通过选中的组形状获取子形状
If visPage.Application.ActiveWindow.Selection.Count = 1 Then
    Set parentShp = visPage.Application.ActiveWindow.Selection(1)
    ' 先确认是组形状
    If parentShp.Type = visTypeGroup Then
        ' 优先用名称引用子形状（避免索引变动出错）
        On Error Resume Next
        Set childShp = parentShp.Shapes("目标子形状名称")
        On Error GoTo 0
        If Not childShp Is Nothing Then
            Debug.Print "子形状文本：" & childShp.Text
        Else
            MsgBox "指定名称的子形状不存在"
        End If
    End If
End If

' 方式2：遍历页面所有组的子形状
Dim shp As Visio.Shape
For Each shp In visPage.Shapes
    If shp.Type = visTypeGroup Then
        For Each childShp In shp.Shapes
            ' 按需筛选子形状（比如带文本的）
            If childShp.Text <> "" Then
                Debug.Print childShp.Name & "：" & childShp.Text
            End If
        Next childShp
    End If
Next shp

二、实现形状按文本值升序排序 #

Visio无内置形状排序方法，需手动收集形状信息、排序后重排布局。以下是完整实现代码：

Sub SortShapesByTextAscending()
    Dim visPage As Visio.Page
    Dim shapeCollection As Collection
    Dim shp As Visio.Shape
    Dim i As Integer, j As Integer
    Dim tempShp As Visio.Shape
    Dim startX As Double, startY As Double, offsetY As Double
    
    ' 布局参数（按需调整，单位：英寸）
    startX = 2       ' 水平起始位置
    startY = 8       ' 垂直起始位置
    offsetY = 0.5    ' 形状垂直间距
    
    Set visPage = Visio.ActivePage
    Set shapeCollection = New Collection
    
    ' 1. 收集需排序的形状（筛选带文本的非组形状，可按需修改条件）
    For Each shp In visPage.Shapes
        If shp.Text <> "" And shp.Type <> visTypeGroup Then
            shapeCollection.Add shp
        End If
    Next shp
    
    ' 2. 按文本升序排序（冒泡排序，忽略大小写）
    For i = 1 To shapeCollection.Count - 1
        For j = i + 1 To shapeCollection.Count
            If UCase(shapeCollection(i).Text) > UCase(shapeCollection(j).Text) Then
                Set tempShp = shapeCollection(i)
                shapeCollection.Remove i
                shapeCollection.Add tempShp, Before:=j
            End If
        Next j
    Next i
    
    ' 3. 重新排列形状位置
    For i = 1 To shapeCollection.Count
        With shapeCollection(i)
            .Cells("PinX").FormulaU = startX
            .Cells("PinY").FormulaU = startY - (i - 1) * offsetY
        End With
    Next i
    
    MsgBox "完成" & shapeCollection.Count & "个形状的排序"
End Sub

代码说明 #

• 筛选条件：可修改If shp.Text <> "" And shp.Type <> visTypeGroup，比如只处理特定图层、名称前缀的形状
• 排序逻辑：用UCase统一转大写，避免大小写干扰排序结果
• 布局调整：startX、startY、offsetY可根据画布尺寸修改

三、解决偶发的“Requested operation is presently disabled”错误 #

该错误多因Visio未就绪、文档只读或形状锁定导致，解决方法：

• 确保文档可编辑，目标形状未锁定（检查LockPinX/LockPinY等属性）
• 代码开头添加就绪检查：

' 等待Visio完成后台操作
Do While Visio.Application.IsBusy
    DoEvents
Loop

内容的提问来源于stack exchange，提问作者Geographos