VisioのマクロでER図のエンティティー名を取る

物理名と論理名を分けて記述できるERツールのフリーの良いのが無くて
結局いまだにVisioにお世話になっています。

VisioのER図は、メタ情報を書き出す仕組みが無く、
マクロを組もうとしても、表示されてる情報しかアクセスできません。
つまり、リレーション・スキーマなどのメタ情報は取れずエンティティーも
1つのShapeとしてしか扱えません。

とはいえ、利用できるときもあるので以下にスクリプトを。。

Sub macro1()
    Dim shap As Shape
    Dim message As String
    Dim lyr As Layer

    For Each Item In ActivePage.Shapes
        Set shap = Item
        If shap.LayerCount > 0 Then
            If shap.Layer(1).NameU = "Entities" Then
                message = message & shap.Shapes(1).Text & vbCrLf
                MsgBox shap.Shapes(1)
                MsgBox shap.Shapes(2).Text
            End If
        End If
    Next
    MsgBox message
End Sub