図形データを取得・設定する方法

今回は図形データを取得・設定する方法を簡単なサンプルコードを交えてご紹介していきます。

図形データとは？

一旦図形データの操作についてご紹介しています。
不要な方はすっ飛ばしてください！

図形データの見方

図形データは図形を右クリックすると出てくる「データ」から「図形データ」を選ぶと出てきます。

表示したものがこちら↓↓↓です。

値の方をクリックすると入力窓が出てきます（今回の入力は適当です）。

図形データの項目を設定する

図形データは図形を右クリックすると出てくる「データ」から「図形データの定義」を選択すると追加削除も可能です。例えば上の図形データなら部製品番号の項目を削除するとか、色を追加するとか。PCならOSを追加するとか。

そして表示されたものがこちら↓↓↓です。

下部の「削除(D)」「新規作成(E)」ボタンで項目の編集ができます。

図形データはシェイプシートで取得編集できる

こちらの図形データですがシェイプシートのRowインデックス＝Shape Dataセルに出てきます。こんな↓↓↓感じ！なのでここからデータ取得・設定すればOKです。

シェイプシートのカラムインデックスは「図形データの定義」で定義した名前と一致します。
下の例ではこのように対応しています。

図形データの名前：DepartmentとシェイプシートのRowインデックス：Prop.Department
図形データのラベル：部署とシェイプシートのLabel：部署

図形データを取得する方法

構文

Visio VBAで図形データの値を取得する構文はこちら。

図形データの値 ＝ 図形.Cells(“Prop.図形データの名前.Value”)

取得するデータが文字列なら

図形データの値 ＝ 図形.Cells(“Prop.図形データの名前.Value”) .Formula

ここで１つ注意！！

ここで参照しようとしている「図形データの名前」がない場合、”予期しないEOF”エラーが発生します。 なのでCellExistsプロパティを使用して「図形データの名前」 という名前のセルが存在するかどうかを判断します。

Sample

こちらのフロアマップに書いてある、PC / ノートPCの図形データからOSを取得するプログラムをSampleとします。それぞれの図形データには名前やOSが入力されているものとします。

コード

Sub test1()

  Dim shp As Shape


　　'ページ内の全ての図形について
    For Each shp In ActivePage.Shapes

　　　'OperationSystemという項目があるかどうかチェック
      If shp.CellExists("prop.OperationSystem", 0) Then
　　　　'名前とOSをイミディエイトウインドウに出力
        Debug.Print shp.Name
        Debug.Print shp.Cells("prop.OperationSystem.Value").Formula
　　
        Debug.Print vbCrLf
      End If
    Next

End Sub

実行結果

イミディエイトウインドウにこんな感じで出力されたのではないでしょうか。

図形データを設定する方法

構文

Visio VBAで図形データの値を取得する構文はこちら。

図形.Cells(“Prop.図形データの名前.Value”) ＝”””図形データに設定したい値”””

取得するデータが文字列なら

図形.Cells(“Prop.図形データの名前.Value”) ＝”””図形データに設定したい値”””

Sample

取得のサンプルの続きで、今度はデスクにスマホを置いていこうと思います。今回はオリジナルのスマホを描いて、図形データの必要な項目は作ってあります。そして設定したことが見て分かるようにフィールドでスマホのモデルを表示するようにしています。

コード

ちょっと長くなってしまいましたが、テキストファイルからデータを読み込んで図形データに設定するコードになっています。

テキストはこんな感じで作っています。ファイル名はTestData.txtとしました。

*Aさんのスマホ
電話番号：090-1111-0000
発売元：Samsung
モデル：Galaxy A41
シリアル番号：SA000011

・
・（省略）
・

*Eさんのスマホ
電話番号：070-5555-0000
発売元：SHARP
モデル：AQUOS with3
シリアル番号：SH000055

図形データを設定しているところは赤くしておきましたので、そこだけ見たい方はどうぞ。

Sub test2()

  Dim shp
  Dim Target As String
  Dim FileBuf(100) As String
  Dim ShpName
  
  
'***************** ファイル読み込み部分 ******************
  
  Target = "お好きなフォルダ\TestData.txt"
    
    
  If Dir(Target) = "" Then  '設定ファイルの有無をチェック
    MsgBox ("ファイルがありません。")
    GoTo NoFileLabel
  End If
  
  'ファイルを開きます。
  Open Target For Input As #1
    
  LineCount = 0
  'ファイルの末尾まで繰り返し
  Do While Not EOF(1)
        
    'ラインごとデータ読み込み
    Line Input #1, FileBuf(LineCount)
    LineCount = LineCount + 1
        
  Loop
    
  Close #1
  
  
'***************** 図形データ設定部分 ******************
    
  SCount = 0
    
  '読み込んだテキストを1行ずつ処理
  For i = 0 To LineCount
    
    'シェイプ名をセット
    If (Left(FileBuf(i), 1) = "*") Then
      
      '図形をコピーします
      ActivePage.Shapes.Item("スマホorg").Copy
      ActivePage.PasteToLocation 8.4 + 0.67 * SCount, 5.8, 0
      SCount = SCount + 1
      
      ShpName = Mid(FileBuf(i), 2, 7)
      ActiveWindow.Selection(1).Name = ShpName
      Set shp = ActivePage.Shapes.Item(ShpName)
      shp.Cells("Prop.Name.Value").Formula = """" & Mid(FileBuf(i), 2) & """"
    
    Else
      
      '図形データを設定する
      If (Left(FileBuf(i), 5) = "電話番号：") Then
        shp.Cells("Prop.PhoneNumber.Value").Formula = """" & Mid(FileBuf(i), 6) & """"
      ElseIf (Left(FileBuf(i), 4) = "発売元：") Then
        shp.Cells("Prop.Manufacturer.value").Formula = """" & Mid(FileBuf(i), 5) & """"
      ElseIf (Left(FileBuf(i), 4) = "モデル：") Then
        shp.Cells("Prop.ProductModel.value").Formula = """" & Mid(FileBuf(i), 5) & """"
      ElseIf (Left(FileBuf(i), 7) = "シリアル番号：") Then
        shp.Cells("Prop.SerialNumber.value").Formula = """" & Mid(FileBuf(i), 8) & """"
      End If
    
    End If
    
  Next
  
NoFileLabel:

End Sub

実行結果

スマホのモデルが表示されて、図形データを覗いてみるとこんな感じでデータが入っていると思います。