- 締切済み
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 上記の？？？にどのようなコードを書けば実現可能でしょうか・・・ 過去ログや掲示板などから、調べてみたのですが、お手上げ状態です。 ご教授頂けると大変助かります。 よろしくお願いいたします。
- haru2026
- お礼率100% (14/14)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- 米沢 栄蔵（@YON56）
- ベストアンサー率36% (37/102)
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 参考の参考 この構文は、写真を貼付したファイルのサイズを減らし、メールの添付ファイルとして送りやすくするための、マクロの一部です。
関連するQ&A
- ShapeのVBAの中での取り扱い
ShapeのVBAの中での取り扱いに関して、サジェスチョン願います。 Shapeに文字が書き込まれていない段階で、選択して文字を読み込み判定しようとするとエラーとなります。 下記のVBAでは、5番目のShapeが該当します。 このエラーを防ぐためには、On Error Resume Nextが有効ですが、他の方法を探しています。例えば、charactor=trueみたいなもの。 ----- Sub Shapeの調査() Dim nametemp(10) As String Dim temp As Integer Dim i As Integer Dim aaa As Variant 'On Error Resume Next ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, 50, 50).Select ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 150, 150, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeRectangle, 200, 200, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeOval, 250, 250, 50, 50).Select temp = ActiveSheet.Shapes.Count For i = 1 To temp ActiveSheet.Shapes(i).Select nametemp(i) = ActiveSheet.Shapes(i).Name Next For i = 1 To temp / 2 + 1 '4つのshapeに対し、文字を書き込もうとする ActiveSheet.Shapes(nametemp(i)).Select Selection.Characters.Text = "" Next For i = 1 To temp / 2 '3つに対して、文字を書き込む ActiveSheet.Shapes(nametemp(i)).Select Selection.Characters.Text = "zzzzz" Next For i = 1 To temp ActiveSheet.Shapes(nametemp(i)).Select aaa = Selection.Characters.Text '<--5番目のShapeに対し If aaa = "zzzzz" Then MsgBox (aaa)'<--errorとなる。 Next End Sub
- ベストアンサー
- オフィス系ソフト
- VBAで関数を使うには？
こんな感じだったとします。 Ａ１ Ｂ１ 2002/9/2 2002/9/3 2002/9/4 2002/9/5 ： このＢ１にそれぞれの曜日を表示させるVBAを以下のようにしました。 Sub youbi() Dim i As Integer For i = 3 To 10 Cells(i, 3).Value = Weekday(Cells(i, 2), "aaa") Next End Sub もちろんエラーでした。 （メッセージは「型が一致しません」です。） そこで以下のように変更しました。 Sub youbi() Dim i As Integer For i = 3 To 10 Cells(i, 3).Value = "=text(Weekday(b3), ""aaa"")" Next End Sub するときちんと曜日が表示されたのですが、もちろん全部B3のセルの日付の曜日です。 ここを変数にするにはどうしたらいいのでしょうか？ とっても簡単なことのように思えますが、意外とハマってしまって抜け出せません。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAの記述方法の質問です。
エクセルです。12個のセルの文字列をオートシェープの吹き出しに順に表示させるマクロをつくりました。 Sub tenki2() Dim i As Integer Dim a As String For i = 1 To 12 a = Cells(i, 2).Value ActiveSheet.Shapes("AutoShape 4").Select Selection.Characters.Text = a Application.Wait Now + TimeValue("00:00:05") Next i End Sub これで思った通り表示されるのですが、できればオートシェープをセレクトしないようにしたいのです。 （シートを保護するため） それで ActiveSheet.Shapes("AutoShape 4").Select Selection.Characters.Text = a のところを ActiveSheet.Shapes("AutoShape 4").Characters.Text = a と変えたのですが、「オブジェクトはこのプロパティまたはメソッドをサポートしていません」という実行時エラーがでてしまいました。書き方のどこがまずかったのでしょうか？ご教示いただければ幸いです。
- ベストアンサー
- オフィス系ソフト
- vba スライドに図形を挿入し文字を入力するには
一番最後のスライドに、図形を挿入するところまでは出来たのですが その図形に文字を表示するにはどうすればいいでしょうか？ Sub test() Dim myDocument As Variant i = ActivePresentation.Slides.Count Set myDocument = ActivePresentation.Slides(i) myDocument.Shapes.AddShape Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=100, Height:=50 myDocument.Shapes.Title = "a" myDocument.Shapes.Text = "a" End Sub まではできたのですが、 myDocument.Shapes.Title = "a" myDocument.Shapes.Text = "a" がエラーになります。 別に図形ではなくてもテキストボックスが挿入できればそれでいいのですが、 図形の挿入の仕方しかわかりませんでした。
- ベストアンサー
- PowerPoint（パワーポイント）
- VISIOでVBAを使っての図形描画
VISIOで自動で図形を描画するVBAを作成しております。 テキストからのデータの取得、 取得したデータにしたがっての、 長方形の作図、線の作成は出来ました。 この発展系として、 取得した座標を使っての図形の描画(例：三角形、中が塗れるやつ)が 上手くできません。 VISIOで普通に線を書くと、線をつなげて書いて、 最後に始点とつなげると、自動で図形になり、中を塗ることが出来るようになります。 ためしに、マクロの自動記録で、↑の作業をマクロ化してみましたが、 1個の三角形を書くマクロが生成され(ShapeのIDが決め打ち) 目的のような使い方は出来ませんでした。 お手数ですが、サンプルコード等ありましたら、お教えください。
- ベストアンサー
- Visual Basic
- エクセルＶＢＡでオートシェイプを点滅させたい。
エクセル２０００です。 ワークシートに配置したオートシェープ（「矢印」と名前を付けてあります。）をチカチカさせたいのです。 Sub マーク点滅() Dim i As Integer i = 0 Do i = i + 1 Loop Until i = 3 Sheets("AAAA").Shapes("矢印").Visible = True Sheets("AAAA").Shapes("矢印").Visible = False End Sub とやってみましたがぜんぜんだめでした。 いい方法はないでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセル2007でVBAが動きません、助けて下さい
先日、使用していたエクセルを2003から2007に変更した所、 オブジェクトのテキストが読み込めなくなってしまいました。 マクロの記録なども試したのですが、問題が解決せず 困っています。 原因が分かる方が入らしたら、ぜひとも教えてください。 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Sub namae() Dim namae1 As String Dim namae2 As String namae1 = Application.Caller namae2 = ActiveSheet.Shapes(namae1).TextFrame.Characters.Text MsgBox namae2 End Sub
- ベストアンサー
- Visual Basic
- VBA シート上のボタンクリックしたら実行
お世話になっております。 シート上に、予定１、予定２… 実際１、実際２… という名前で作成したオートシェイプがあります。 このオートシェイプをクリックしたら、 既にあるオートシェイプ(矢印）を消し、 オートシェイプ（矢印）を作成するというものをしたいと思っています。 -------------------------- Sub Test() Dim TESTShape As Shape Dim i As Long Dim j As Long j = 1 For i = 5 To 64 With ActiveSheet.Range("J" & i) If i Mod 2 = 1 Then '2で割って余りが１なら Set TESTShape = ActiveSheet.Shapes.AddShape( _ msoShapeRectangle, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height) TESTShape.Fill.Visible = msoTrue TESTShape.Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = 41 TESTShape.Name = "予定" & j ' Else Set TESTShape = ActiveSheet.Shapes.AddShape( _ msoShapeRectangle, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height) TESTShape.Name = "実際" & j ' j = j + 1 End If End With Next End Sub -------------------------- 上記プログラムで、シート上にボタンを作成しました。 そのシートに直接プログラムを書き込み？ Private Sub 予定1_Click() MsgBox "TEST" End Sub と試してみていますが、オートシェイプから シートプログラム？の実行はできないのでしょうか。 このシートは色んなシートにコピーして使おうと思っているため、 ボタンをおしたら矢印を消したり、追加したりする動作も他のブックにコピーしたいと思っています。 そのためシートに書き込もうとしているのですが、上手く行かず… 根本的に、なにか間違っているかもしれません。 シートに書き込むプログラムをどう書くべきなのかあまり良くわかっておりません…。 シート上のボタンをクリックしたら実行できるのは、 標準モジュールに書き込んだプログラムのみなのでしょうか？ 質問がわかりにくく、説明不足の点も多々あるかもしれません。 その場合は、どんどん聞いてください。お願いします。 回答お待ちしております。
- ベストアンサー
- Excel（エクセル）
- ＶＢＡ オートシェイブや図を選択したいのですが
ＶＢＡでシート上にある全てのオートシェイブや図を選択したいのですが どのようにすればいいでしょうか？ 手作業でなら、CTRL+Gでオブジェクトを選択すればできますがVBAで行いたいです。 Sub test() Dim s As Shape For Each s In ActiveSheet.Shapes s.Select Next End Sub をしても、一つずつしか選択できません。 全てを選択状態にしたいです。
- ベストアンサー
- オフィス系ソフト
- Excel VBA 数値を入れ 図形の線を変える
図形を作成し、毎年更新をするのですが 数値を入れて、画像の線の幅を変更したいです。 下記、内容で作成したのですが、うまく動きません。 何が問題でしょうか？ 数値を入れる場所は、B51になります。 Sub Macro1() ' Dim i As Integer Dim ws1 As Worksheet Set ws1 = ActiveSheet For i = 1 To 20 ActiveSheet.Shapes(ws1.Cells(50 + i, 1).Value).Select Selection.ShapeRange.Line.Weight = ws1.Cells(50 + i, 2).Value Next i End Sub
- 締切済み
- Visual Basic
お礼
YON56様 こんにちは。ご回答誠にありがとうございました！ 考え方、コーディング手法、とても参考になりました。 こちらは、エクセル用のVBAになりますでしょうか？ Visioとほぼ、考え方が同じと思うのですが、Visio上ではうまく動かなかったので・・・ でも、エクセルのVBEにコピーし、ステップインしながら、確認したところ、うまく動きました。 教えて頂いた考え方、私にはとても出来ないので、とても勉強になりました。 所々に技があっておもしろいです！ 今後とも、よろしくお願いいたします。