如何通过宏将Visio形状文本导出至Excel？

不推荐使用该方案，因为Visio自带的报告功能导出的文本比该宏更全面。话虽如此，以下代码可以正常运行：

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 "文本导出完成", 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

感谢Visguy论坛的@PaulHerber、@Surrogate和@wapperdude提供相关内容支持。

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