エクセルVBAでオートシェープの吹き出しに文字列を表示する方法
- エクセルVBAを使用して、オートシェープの吹き出しにセルの文字列を表示する方法について質問です。
- 現在、オートシェープの吹き出しにセルの文字列を表示するマクロを作成していますが、セレクトする必要があります。
- セレクトせずに文字列を表示する方法を知りたいです。変更したところ、「オブジェクトはこのプロパティまたはメソッドをサポートしていません」というエラーが発生しました。どこが間違っているのか教えてください。
- ベストアンサー
エクセル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 と変えたのですが、「オブジェクトはこのプロパティまたはメソッドをサポートしていません」という実行時エラーがでてしまいました。書き方のどこがまずかったのでしょうか？ご教示いただければ幸いです。
- otasukey
- お礼率77% (105/136)
- オフィス系ソフト
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
> ActiveSheet.Shapes("AutoShape 4").Characters.Text = a > と書くと保護の有無にかかわらず実行時エラーなのです。 ActiveSheet.Shapes("AutoShape 4").TextFrame.Characters.Text = a
その他の回答 (1)
- taknt
- ベストアンサー率19% (1556/7783)
シートを保護させたから エラーになったんでしょう。 保護したまま、ＶＢＡのほうで、解除して、再度 保護するようにしてみれば？ '保護の解除 ActiveSheet.Unprotect ActiveSheet.Shapes("AutoShape 4").Select Selection.Characters.Text = a 'シートの保護 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
補足
> シートを保護させたから エラーになったんでしょう。 ActiveSheet.Shapes("AutoShape 4").Select と書けば保護時にはエラーになるし、解除すればもちろん大丈夫です。それはわかるのです。 ActiveSheet.Shapes("AutoShape 4").Characters.Text = a と書くと保護の有無にかかわらず実行時エラーなのです。 だから、この書き方のどこがまずいのか知りたいのです。 よろしくお願いします。
関連する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の記述方法
毎月下記のような処理をしたい。 (1)． ３０シートの中からその月に必要なシートのみを別ブックにコピーし作成する (2)． (1)で作成したシートの不要行（A列B列）を削除する (3)． (1)で作成したシートのマクロボタン（５個）を削除する (4)． (1)で作成したシートのリンクを削除する（コピー元のリンクは保持） その為に下記のようなマクロを作ってみました Sub リンク解除() マクロ記録日 : 2006/3/4 ユーザー名 : isekaoru (1)． ActiveWorkbook.ActiveSheet.Copy (2)． Columns("A:B").Select Selection.Delete Shift:=xlToLeft (3)． ActiveSheet.Shapes("AutoShape 4").Select Selection.Cut ActiveSheet.Shapes("AutoShape 5").Select Selection.Cut ActiveSheet.Shapes("AutoShape 3").Select Selection.Cut ActiveSheet.Shapes("AutoShape 2").Select Selection.Cut ActiveSheet.Shapes("AutoShape 1").Select Selection.Cut (4)．ActiveWorkbook.BreakLink Name:= _ "C:\Documents and Settings\ isekaoru\My Documents\１７年度計表 .xls" _ , Type:=xlExcelLinks Range("A1").Select End Sub 御教示頂きたき事 １．多数のブックに共通で使用出来るようにしたい ２．(2)～(3)のマクロ本来の記述方法 ３．(4)の共通に使用出来る記述方法 * 編集（E)→リンクの設定（K)→リンクの編集画面のリンクの解除（B)をマクロに写したものです。 VBAの記述は出来ない初心者です、御指導宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- Excelでグループ化したオートシェイプにテキストを編集するコード
Excelの四角のオートシェイプで、例えば、「四角1」「四角2」「四角3」という名前のオートシェイプが3つあったとしてテキスト編集で同じ文字列を入れたいとき、 For a = 1 To 3 ActiveSheet.Shapes("四角" & a).Select Selection.Characters.Text = "文字列" Next a とすればできるのですが、「四角1～3」をグループ化し、名前を「四角」としたとき、 ActiveSheet.Shapes("四角").Select Selection.Characters.Text = "文字列" とするとエラーが出てしまいます。グループ化されたオートシェイプのテキスト編集は、一度グループを解除し、それぞれテキスト編集しなければならないのでしょうか？ 回答よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- EXCEL VBA これであっていますか？
エクセルに地図を貼り付け、その中のある地点Aから半径１キロ、２キロ、３キロといった具合に円を描いています。ある地点B、Cも同様に円があります。セルに“A” と入力した際に該当する地点の円（１キロ、２キロ、３キロの3種類）を赤く表示し、終了すると円が消える（線なしに変わる）ようにするために以下のようなＶＢＡを組みました。が、円が２つしか赤くならなかったり、 ばあいによっては「インデックスが境界を超えています」とエラーが出たりします。 どうしたら良いか教えてください。 Sub iro() Dim i As Variant i = InputBox("表示する地点を指定してください", "地点指定") If i = "A" Then ActiveSheet.Shapes(1).Select ActiveSheet.Shapes(2).Select ActiveSheet.Shapes(3).Select Replace:=False hyoji MsgBox "表示を終了してよろしいですか", vbOKOnly ActiveSheet.Shapes(1).Select ActiveSheet.Shapes(2).Select ActiveSheet.Shapes(3).Select Replace:=False modosu ElseIf i = "B" Then ActiveSheet.Shapes(4).Select ActiveSheet.Shapes(5).Select ActiveSheet.Shapes(6).Select Replace:=False hyoji MsgBox "表示を終了してよろしいですか", vbOKOnly ActiveSheet.Shapes(4).Select ActiveSheet.Shapes(5).Select ActiveSheet.Shapes(6).Select Replace:=False Else MsgBox "指定した地点がありません", vbOKOnly End If End Sub Sub hyoji() Selection.ShapeRange.Line.Visible = msoTrue '「線なし」に設定されている場合、線を表示 Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Range("A1").Select End Sub Sub modosu() Selection.ShapeRange.Line.Visible = msoFalse '「線なし」に設定 Range("A1").Select End Sub
- ベストアンサー
- オフィス系ソフト
- VBAでオートシェイプのグループ化についての質問です。
VBAでオートシェイプのグループ化についての質問です。 オートシェイプ線（Line）で台形を作成し全てを選択し、グループ化したいと考えています。 また、連続して台形を作成していきたいと考えています。 ?4本線を引く ?グループ化（Aグループ） ?4本線を引く ?グループ化（Aグループ） ⇒ 連続して作成・・・ Dim st() As Variant Dim ob As Shape Dim MyLine As Shape '線の作成 Set MyLine = ActiveSheet.Shapes.AddLine(startX, startY, widthX, heightY) '線の選択 For Each ob In ActiveSheet.Shapes ReDim Preserve st(j) st(j) = ob.name j = j + 1 Next ob 'グループ化 Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select と上記コードで一つのグループは作成出来たのですが、次に作成すると Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select でエラーになります。 恐らく前のグループ化内の線も選択してしまうのではないかと思っていますが、対処の仕方が解りません。 線の作成方法から選択方法等いろいろ意見が聞きたいと思っています。 アドバイスよろしくお願いいたします。 m(__)m
- ベストアンサー
- その他（プログラミング・開発）
- Excelのマクロを使用してオートシェイプ図形の色を変えたいのです。
Excelのマクロを使用してオートシェイプ図形の色を変えたいのです。 オートシェイプ図形を５０個ならべて、マウスでクリックしてものは色が変わるようにしたいと思います。 マクロ記録をすると以下のようになりました。 Sub Macro1() ActiveSheet.Shapes("AutoShape 1").Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = 45 Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.Solid End Sub このプログラムを５０個書くわけにはいかないのですが、プログラムで処理するのに問題点が２つ出てきました。 ・オートシェイプ図形の名前が"AutoShape 1"となっていますが、これを変更したいのですが、書式設定にはありませんでした。変更するにはどうすればよいのでしょう？ ・クリックしたオートシェイプ図形がどれであるかを返す関数がないと、どの図形がクリックされたかわからないのですが、これを返す関数はあるのでしょうか？ よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- エクセル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のGroup化について
お世話になります。以下のマクロがうまく動きません。 ------------------------------------------------- Dim objShp1 As Shape For Each objShp1 In ActiveSheet.Shapes If objShp1.Name = "Picture 3" Then ActiveSheet.Shapes.Range(Array("A", "B", "Picture 3")).Select Selection.ShapeRange.Group.Select Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 Else ActiveSheet.Shapes.Range(Array("A", "B")).Select Selection.ShapeRange.Group.Select <---------(1) Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 End If Next ------------------------------------------------- このマクロは全体の一部分になりますが、（１）のところでエラーになります。 どこが間違っているのか、さっぱりわかりません。 すみませんが、お助けいただければ幸いです。
- 締切済み
- その他MS Office製品
- やはり図形のクリアで実行時エラー1004
図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub
- ベストアンサー
- Visual Basic
- エクセル
図形の中をクリックする度にとA～Gと変化するコードを以下にて作成しましたがA～Gではなく図形の中に7つの文字(確認要、手続き中など)を表記したいのですがマクロコードがうまくできません。ご教示願います。 Sub 四角形1_Click() a = Array("", "A", "B", "C", "D", "E", "F", "G") ActiveSheet.Shapes("Rectangle 1").Select c = Selection.Characters.Text If Left(c, 1) = a(UBound(a)) Then Selection.Characters.Text = "" Else For i = 0 To UBound(a) - 1 If Left(c, 1) = a(i) Then Selection.Characters.Text = a(i + 1) Exit For End If Next i End If Cells(1, 1).Select End Sub
- ベストアンサー
- Visual Basic
お礼
ありがとうございました！ うまく行きました。 マクロの自動記録では絶対わからない書き方ですね。 助かりました。