visioの文字の抽出結果をエクセルかテキストに表示させたい

投稿者 : sos     投稿日時 : 2023/04/20(Thu) 09:09:49     OS : Windows 11     EXCEL : Office 365

---

現在、
visioの文字の抽出結果はイミディエイトに表示されるが、エクセルに表示されない、エクセルかテキストに表示させたい。
なお、抽出数は約500あるが、イミディエイトの限界行は約200であるため、イミディエイトですべては表示されず、約200は表示される。

Option Explicit

'部品シンボルから取り出す情報を構造体として定義
Private Type typPartsSymbol
    シンボル番号 As String
    型番 As String
    他 As String
End Type

Public Sub CountVisioShapes()
    Dim TargetFilename As Variant

    Dim VsdApp As Visio.Application     'Visioアプリケーションオブジェクト
    Dim VsdDoc As Visio.Document        'Visioドキュメントオブジェクト(１ファイル単位)
    Dim VsdPage As Visio.Page           'Visioページオブジェクト(１ページ単位)
    Dim VsdShape As Visio.Shape         'Visioシェイプオブジェクト(１つの図形)
    Dim FildName As String              '図形データで定義したデータの名前
    Dim FildText As String              '図形データで定義したデータの値
    Dim PartsSymbol As typPartsSymbol

    'ファイルを選択するダイアログを利用して読み込むVisioファイルを指定する
    TargetFilename = Application.GetOpenFilename(FileFilter:="Visioファイル,*.vsdx", MultiSelect:=False)

    'Visioアプリケーションオブジェクトをインスタンス
    Set VsdApp = CreateObject("Visio.Application")

    'Visioアプリケーションオブジェクトで対象のVisoファイルを開く
    Call VsdApp.Documents.OpenEx(TargetFilename, visOpenRO + visOpenHidden)

    'Visioドキュメントオブジェクトで対象のVisoファイルを開く
    Set VsdDoc = VsdApp.Documents.Item(1)

    'Visioのすべてのページについて処理する
    For Each VsdPage In VsdDoc.Pages
        'すべてのシェイプ(図形)について処理する
        For Each VsdShape In VsdPage.Shapes

            'シェイプの名前が部品ライブラリとして命名した"e_"だけ処理する
            If InStr(VsdShape.Name, "e_") Then
                'Visioシェイプのセル名を指定して、対象から文字を取り出す
                With PartsSymbol
                    .シンボル番号 = VsdShape.Cells("Prop.ref").Formula
                    .型番 = VsdShape.Cells("Prop.Unit").Formula
                    .他 = VsdShape.Cells("Prop.other").Formula

                    'デバッグ表示
                    Debug.Print .シンボル番号 & ":" & .型番 & ":" & .他
                End With
            End If
        Next
    Next
    'ファイルを閉じる
    VsdDoc.Close
    VsdApp.Quit
    'オブジェクト破棄
    Set VsdDoc = Nothing
    Set VsdApp = Nothing
End Sub

投稿者 : さんこう     投稿日時 : 2023/04/20(Thu) 09:24:57

---

ここ↓を、エクセルかテキストに出力するようにすればいいように思います。

'デバッグ表示
Debug.Print .シンボル番号 & ":" & .型番 & ":" & .他


例えば、こんなのとか。

Cells(Rnd() * 500 + 1, Rnd() * 500 + 1) = .シンボル番号 & ":" & .型番 & ":" & .他

投稿者 : sos     投稿日時 : 2023/04/20(Thu) 10:37:01

---

■[返信 1] さんこうさん（2023-04-20 09:24:57）の記事
＞ ここ↓を、エクセルかテキストに出力するようにすればいいように思います。
＞
＞ 'デバッグ表示
＞ Debug.Print .シンボル番号 & ":" & .型番 & ":" & .他
＞
＞
＞ 例えば、こんなのとか。
＞
＞ Cells(Rnd() * 500 + 1, Rnd() * 500 + 1) = .シンボル番号 & ":" & .型番 & ":" & .他

ありがとうございます！
エクセルのセルにランダムにvisioの文字「シンボル番号 & ":" & .型番 & ":" & .他」が抽出され表示されました！

恐れ入りますが、次は、ランダムのセル場所に表示させるのではなく、
エクセルのa1から１段ずつ下がって、「シンボル番号 & ":" & .型番 & ":" & .他」を表示させたいです。
ご教示ください。。。

Option Explicit

'部品シンボルから取り出す情報を構造体として定義
Private Type typPartsSymbol
    シンボル番号 As String
    型番 As String
    他 As String
End Type

Public Sub CountVisioShapes()

    Dim TargetFilename As Variant

    Dim VsdApp As Visio.Application     'Visioアプリケーションオブジェクト
    Dim VsdDoc As Visio.Document        'Visioドキュメントオブジェクト(１ファイル単位)
    Dim VsdPage As Visio.Page           'Visioページオブジェクト(１ページ単位)
    Dim VsdShape As Visio.Shape         'Visioシェイプオブジェクト(１つの図形)
    Dim FildName As String              '図形データで定義したデータの名前
    Dim FildText As String              '図形データで定義したデータの値
    Dim PartsSymbol As typPartsSymbol

    'ファイルを選択するダイアログを利用して読み込むVisioファイルを指定する
    TargetFilename = Application.GetOpenFilename(FileFilter:="Visioファイル,*.vsdx", MultiSelect:=False)

    'Visioアプリケーションオブジェクトをインスタンス
    Set VsdApp = CreateObject("Visio.Application")

    'Visioアプリケーションオブジェクトで対象のVisoファイルを開く
    Call VsdApp.Documents.OpenEx(TargetFilename, visOpenRO + visOpenHidden)

    'Visioドキュメントオブジェクトで対象のVisoファイルを開く
    Set VsdDoc = VsdApp.Documents.Item(1)

    'Visioのすべてのページについて処理する
    For Each VsdPage In VsdDoc.Pages
        'すべてのシェイプ(図形)について処理する
        For Each VsdShape In VsdPage.Shapes

            'シェイプの名前が部品ライブラリとして命名した"e_"だけ処理する
            If InStr(VsdShape.Name, "e_") Then
                'Visioシェイプのセル名を指定して、対象から文字を取り出す
                With PartsSymbol
                    .シンボル番号 = VsdShape.Cells("Prop.ref").Formula
                    .型番 = VsdShape.Cells("Prop.Unit").Formula
                    .他 = VsdShape.Cells("Prop.other").Formula



                    'デバッグ表示
                    Cells(Rnd() * 500 + 1, Rnd() * 500 + 1) = .シンボル番号 & ":" & .型番 & ":" & .他
                End With
            End If
        Next
    Next
    'ファイルを閉じる
    VsdDoc.Close
    VsdApp.Quit
    'オブジェクト破棄
    Set VsdDoc = Nothing
    Set VsdApp = Nothing
End Sub

投稿者 : さんこう     投稿日時 : 2023/04/20(Thu) 11:39:40

---

＞ランダムのセル場所に表示させるのではなく、エクセルのa1から１段ずつ下がって、「シンボル番号 & ":" & .型番 & ":" & .他」を表示させたいです。

Visioを操るような立派なコードを書かれたかたのご質問とは思えないですが、
こんな↓感じでいかがでしょうか。
（直接入力したので、間違っていたらごめんなさい。）

Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = .シンボル番号 & ":" & .型番 & ":" & .他

投稿者 : sos     投稿日時 : 2023/04/20(Thu) 11:48:16

---

■[返信 3] さんこうさん（2023-04-20 11:39:40）の記事
＞ ＞ランダムのセル場所に表示させるのではなく、エクセルのa1から１段ずつ下がって、「シンボル番号 & ":" & .型番 & ":" & .他」を表示させたいです。
＞
＞ Visioを操るような立派なコードを書かれたかたのご質問とは思えないですが、
＞ こんな↓感じでいかがでしょうか。
＞ （直接入力したので、間違っていたらごめんなさい。）
＞
＞ Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = .シンボル番号 & ":" & .型番 & ":" & .他
＞

ありがとうございます！
おかげで解決しました！

web上に存在するコードを組み合わせており、勉強中です。。。

助かりました！