Visio2003 TEXTWIDTH 関数をVBAで使用したい

質問

こんにちは。いつもお世話になっております。
Microsoft Visio及びVBA勉強中の初心者です。
使用環境は、WindowsXP/Microsoft Visio2003となります。

Visio2003において、ページ内に配置してある、「図形にテキストを追加したシェイプ」に対して、テキストの長さに応じて、シェイプの幅を自動的に変更したいのです。

Microsoft社のMSDNより、シェイプシートのWidth欄に、=TEXTWIDTH(TheText)
を入力すると、自動的に幅が変更する事は確認出来ました。

しかし、これをVBAに置き換えようとすると、私の知識では分かりません・・・

Sub test()
Dim shpObj As Visio.Shape
Dim i As Integer

For i = 1 To ActivePage.Shapes.Count
ActivePage.Shapes.Item(i).Cells("WIDTH") = ？？？
Next i
End Sub

上記の？？？にどのようなコードを書けば実現可能でしょうか・・・
過去ログや掲示板などから、調べてみたのですが、お手上げ状態です。

ご教授頂けると大変助かります。
よろしくお願いいたします。

回答No.1

米沢 栄蔵（@YON56）

haru2026さんへ
Shapesの情報を取得したり、マクロにてShapesの位置やサイズ(4角形の場合)を指示する方法の参考構文を書きます。

これは、前半部で、D番目のシートのなかで、"Picture"という名前が付いているShapesをみつけ、
それが貼付されている最左上のセル名を取得し、それを利用し易いかたちに加工し、Shapesの位置とサイズの情報を取得し、削除しています。
後半部では、ShapesのFormatを変えて貼付し、削除する前のShapesと同じ位置やサイズになるようにするとともに、貼り付けたShapesが最背面になるよう指示したものです。

X=0
For Each ZZZ In Sheets(D).Shapes
X = X + 1
If InStr(ZZZ.Name, "Picture") > 0 Then
CC = ZZZ.TopLeftCell.Address
CC = Right(CC, Len(CC) - 1)
DD = Left(CC, InStr(CC, "$") - 1)
EE = Right(CC, Len(CC) - InStr(CC, "$"))
E = Asc(DD) - 64
F = Val(EE)
ZT = ZZZ.Top
ZL = ZZZ.Left
ZH = ZZZ.Height
ZW = ZZZ.Width
ZZZ.Cut
Cells(F, E).Select
ActiveSheet.PasteSpecial Format:="図 (JPEG)"
Selection.ShapeRange.Top = ZT
Selection.ShapeRange.Left = ZL
Selection.ShapeRange.Height = ZH
Selection.ShapeRange.Width = ZW
Selection.ShapeRange.ZOrder msoSendToBack
End If

参考の参考
この構文は、写真を貼付したファイルのサイズを減らし、メールの添付ファイルとして送りやすくするための、マクロの一部です。

お礼

YON56様
こんにちは。ご回答誠にありがとうございました！
考え方、コーディング手法、とても参考になりました。

こちらは、エクセル用のVBAになりますでしょうか？
Visioとほぼ、考え方が同じと思うのですが、Visio上ではうまく動かなかったので・・・

でも、エクセルのVBEにコピーし、ステップインしながら、確認したところ、うまく動きました。

教えて頂いた考え方、私にはとても出来ないので、とても勉強になりました。
所々に技があっておもしろいです！

今後とも、よろしくお願いいたします。