テキストを取得・追加する方法

テキストは図形をダブルクリックすると入れられる「コレ！」です。今回はVBAを使って自動的に文字を抜き出したり、入れたりする方法をご紹介します。文字を入力できるだけで、いろいろ組み合わせて使い方も広がりますねっ。

テキストを取得する方法

構文

Visio VBAで図形の名前を取得する構文はこちら。

テキスト = 図形.Characters.Text

Sample

選択中の図形の名前を取得して、メッセージボックスに表示させるサンプルです。
こんな感じで↓↓↓4つの図形の中にテキストがあり選択してあるとします。

コード

最初に選んだシェイプがSelection(1)、その次がSelection(2)、メッセージボックス内の”vbCrLf”は改行です。

Sub test1()
Dim text1, text2, text3, text4

    'テキストを取得します。
    text1 = ActiveWindow.Selection(1).Characters.Text
    text2 = ActiveWindow.Selection(2).Characters.Text
    text3 = ActiveWindow.Selection(3).Characters.Text
    text4 = ActiveWindow.Selection(4).Characters.Text
    
    'メッセージで表示してみましょう。
    MsgBox (text1 & vbCrLf & text2 & vbCrLf & text3 & vbCrLf & text4)

実行結果

メッセージボックスに名前が出力されました。シェイプ選択時に、選ぶ順番を変えるとテキストも変わります。

既存の図形に文字列を追加する方法

構文

Visio VBAで図形の名前を変更する構文はこちら。

図形.Characters.Text = “テキスト”

Sample

テキストを追加するサンプルです。

Sub test2()

    '四角を描きます。
    Set rect = ActivePage.DrawRectangle(1, 9, 2, 8)
    
    '線をなしに設定し、テキストを入力
    With rect
      .Cells("LinePattern") = "0"
      .Characters.Text = "こんにちは！ここにテキストを記入してください。"
    End With
    
End Sub

実行結果

メッセージボックスに変更後の名前が出力されました。

次はページをクリックするとテキストが入るコード

コード

こちらページ上をクリックすると「OK！」とコメントが入るだけのコードです。
まずクラスモジュールに「MouseListener」という名前でモジュールを1つ作ります。

Dim WithEvents vsoWindow As Visio.Window
 
Private Sub Class_Initialize()
 
   Set vsoWindow = ActiveWindow
 
End Sub
 
-------------------------------------------------------------------
Private Sub Class_Terminate()
 
   Set vsoWindow = Nothing
 
End Sub

次にThisDocumentにこんなコードを描きます。

Dim myMouseListener As MouseListener
Private WithEvents mywin As Visio.Window

-------------------------------------------------------------------
Private Sub Document_BeforeDocumentClose(ByVal doc As IVDocument)
 
   Set myMouseListener = Nothing
 
End Sub

-------------------------------------------------------------------
Sub DrawWin()

    Set mywin = ActiveWindow

End Sub

-------------------------------------------------------------------
Private Sub mywin_MouseDown(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)

    '四角を描きます。
    Set rect = ActiveWindow.Page.DrawRectangle(x, y, x + 2, y - 0.5)
        
    '線をなしに設定し、テキストを入力
    With rect
      .Characters.Text = "OK！"
      .Cells("LinePattern") = "0"
      .Cells("Char.Color") = "2"
      .Cells("Char.Size").Formula = "36pt"
      .Cells("Char.Style") = "17"
    End With
  
End Sub

実行結果

ページをクリックすると、そこに「OK!」というテキストが入ると思います。