我的宏将所有页中所有Visio形状中的所有文本导出到每个Visio页的Excel工作表中。再次感谢Paul Herber，他将错误识别为ShapesList ActivePage.Shapes，应该是ShapesList vsPage.Shapes，下面的代码现在可以正常工作了。

Sub ExportVisioTextsExcel()
 
    Dim vsPage As Visio.Page
    Dim vsDoc As Visio.Document
    Dim xlApp, xlWB, xlWS, vsApp As Object
    Dim FldPath As String

   
    Set xlApp = CreateObject("Excel.Application")
    Set vsApp = CreateObject("Visio.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    Set vsDoc = vsApp.Documents.Open("C:\xyz\File.vsdx")
    FldPath = "C:\xyz\"
 
    For Each vsPage In vsDoc.Pages
        Set xlWS = xlWB.Sheets.Add(After:=xlWB.Worksheets(xlWB.Worksheets.Count))
        ShapesList vsPage.Shapes, xlWS
    Next vsPage
   
    xlWB.SaveAs FldPath & "xxx" & Format(Now(), "YYYYMMDD")
   
    MsgBox "Texts exported", vbInformation
   
End Sub
 
Sub ShapesList(ByVal shps As Shapes, ByVal xlWS As Object)
    Dim sh As Shape
    Dim vChars As Visio.Characters
    Dim lRow As Long
    lRow = xlWS.Cells(xlWS.Rows.Count, 1).End(xlUp).Row
   
    For Each sh In shps
        If sh.Shapes.Count = 0 Then
            If Not sh.OneD Then
                Set vChars = sh.Characters
                xlWS.Cells(lRow, 1).Value = sh.ID
                xlWS.Cells(lRow, 2).Value = sh.Name
                xlWS.Cells(lRow, 3).Value = vChars.Text
            lRow = lRow + 1
            End If
        End If
        ShapesList sh.Shapes, xlWS
    Next sh
End Sub

感谢http://visguy.com/vgforum/index.php?PHPSESSID=76f6964e4d1518f3495af46e92c2a609&topic=10128.0上的@PaulHerber、@Surrogate和@wapperdude