- ベストアンサー
ExcelVBAでのオートシェイプ選択について
if オートシェイプ選択中 then 処理 end if このような事を考えているのですが、 オートシェイプを選択中という書き方がわかりません。 よろしくお願いします。
- hanamizutarou
- お礼率43% (25/57)
- その他MS Office製品
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- k415
- ベストアンサー率25% (2/8)
ループさせてトリミングなどをやるためにこんなマクロを書いたことがあります。 Dim n For n = 1 To 3 ActiveSheet.Shapes(n).Select Application.Run "V_Z" Next n Next これは、以前使用したマクロですが.Shapes(n).Selectでn番目の図を選択となります。 オートシェイプなどを作成した順だったか下から順だったかで番号がついていて選ぶことができますよ。
お礼
ありがとうございます。 if文での条件に使いたかったので、 if ActiveSheet.Shapes(n).Select then など記述できないために質問しました。 ややこしい質問文で申し訳ないです。
関連するQ&A
- ExcelVBA オートシェイプについて
セルの選択した場所のとなりにオートシェイプを移動させるマクロを組みたいと思っています 見かけがまったく同じシートが４枚あり、そのシート全てに同じマクロを指定したいのですが、オートシェイプの名前の指定の仕方が分からなく困っています SelectionChangeイベントでオートシェイプ移動のマクロを動かしているので、同じ名前のボタンならよいのですが・・・ なにかよい方法はないでしょうか？
- ベストアンサー
- オフィス系ソフト
- 指定範囲内のオートシェイプを数えるには？
I5:I24の範囲内のオートシェイプの数を数え、I25に合計数を表示させるマクロを作っているのですが、どうしても範囲指定の仕方が分かりません。教えてください。 'オートシェイプの合計数算出 Dim shp As Object Dim cnt As Long For Each shp In ActiveSheet.Shapes If shp.Type = msoAutoShape Then If shp.TopLeftCell.Column = 9 Then cnt = cnt + 1 End If End If Next shp Range("I25").Value = cnt このマクロのどこにどう入れればよいでしょうか？
- ベストアンサー
- オフィス系ソフト
- 図形オートシェイプ内のテキスト検索マクロ作成についての質問
VBS2年目のプログラマーです。 Excelで図形オートシェイプ内のテキストが検索できないので、 マクロを作成してみようと思いましたが2点問題が発生しましたので 解決方法または実現方法をご教授ねがいます。 （目標マクロ機能概要） (1)InputBoxで検索文字列を入力 (2)検索文字列と一致するテキストを持つ図形を選択 (3)検索文字列と一致する次の図形を検索するかをMsgboxから選択 (この時、一致する図形は選択されている状態であってほしい) (4)(3)で次の図形を検索しない、または図形をすべて検索するとマクロ終了 （問題) １．機能概要(2)の選択される図形が現在のExcel画面外にある場合、画面が移動しないため、どこに検索ヒットした図形があるか使用者がわからない ２．機能概要(3)で、Msgbox実行時に図形選択が表示されず現在どの図形を選択しているのか使用者がわからない 問題1は、autoshapeオブジェクトのtop,left属性などを 使うしかないのかなとぼんやり考えています。 以下、コードです。 お忙しいところ、申し訳ありませんが 以上、よろしくお願いします。 ************************** Sub GetShapesText() Dim wk_shp As Shape 'オートシェイプ格納変数 Dim wk_search_str As String '検索文字列変数 '*** 検索文字列入力処理 *** wk_search_str = InputBox("検索する図形オートシェイプのテキストを入力してください。", "オートシェイプ内テキスト検索") If (Len(wk_search_str) = 0) Then '検索文字列が未入力の場合は、マクロ終了 Exit Sub End If '*** オートシェイプ検索処理 *** For Each wk_shp In ActiveSheet.Shapes If InStr(wk_shp.Name, "Line") = 0 Then 'オートシェイプが線(Line)以外の場合のみ以下を処理 If (InStr(wk_shp.TextFrame.Characters.Text, wk_search_str) > 0) Then 'オートシェイプのテキストに検索文字列が含まれる場合のみ以下を処理 wk_shp.Select '検索ヒットしたオートシェイプを選択 wk_next_search_flg = MsgBox("次を検索しますか？", vbYesNo) If (wk_next_search_flg = 7) Then '次を検索しない場合は、検索を終了 Exit For End If End If End If Next End Sub **************************
- ベストアンサー
- Visual Basic
- エクセルVBAオートシェイプがあったら、の書き方
皆さんこんにちは。 エクセルVBAの初心者です。 IFを使った条件分岐が私には難しかったので SELECTCASEを用いてみようと思うのですが条件の書き方が分かりません。 やりたい事は セルA1が「文字が入っていない且つオートシェイプが入っていない場合」のみ アクション（オートシェイプ☆を貼る）を起こしたい、です。 イメージ的にこうなるかな？と思いコードを作成しましたが ケース2の「オートシェイプがあったら」という条件の書き方が分かりません。 Sub オートシェイプ貼り付け() With ThisWorkbook.Worksheets("Sheet1") Select Case True Case .Range("A1").Value <> "" Exit Sub Case オートシェイプがあったら Exit Sub Case Else オートシェイプ☆を貼る End Select End Sub オートシェイプの有無を条件にするにはどのような書き方をすれば良いでしょうか？
- ベストアンサー
- Excel（エクセル）
- Word2003でオートシェイプ高さを3mm程度に
Word2003 SP3で、オートシェイプを選択し、 Alt＋ドラッグ操作で高さを小さくしていっても4.85mmで頭打ちになり それ以上小さくできません。 ・同じ操作で幅は、3.18mmまでは小さくできます。 ・オートシェイプの書式設定ダイアログで値を直接指定すれば もっと小さくできますが、毎回そんな手間が掛かっては話になりません。 （それで高さを3mmにしても、その後ドラッグで幅調節しようとすると、 高さが4.85mmに押し戻されてしまう） ・同じ環境でも書類によっては、3.18mmまで小さくできます。 ・シェイプ内のテキスト有無や線の太さは関係ないようです。 ●書類によって4.85mmで頭打ちになる現象を解決できないでしょうか？ 妥協策として、以下のようなマクロを組んで、ショートカットキーに 割り当て、平易に高さ調節できるようにしてみたのですが、 描画キャンバス内にあるオートシェイプを選んで操作した時に 描画キャンバス全体が（操作対象となって）小さくなってしまいます。 ●描画キャンバス内で選択したオートシェイプのみを対象に 操作が適用されるようにする方法はないものでしょうか？ Sub オートシェイプ高さを小さくする() If Selection.Type <> wdSelectionShape Then End Selection.ShapeRange.Height = Selection.ShapeRange.Height - 1 End Sub
- ベストアンサー
- オフィス系ソフト
- オートシェイプの文字が更新されない。
こんにちは。 タイトルの件で、投稿いたします。 【現状】 ・EXCEL20007を使用しています。 ・シート構成は、カテゴリ選択シート、メニューシート、その他20シート程度。 --- 現在マクロを使用して、ある機能を実装しています。 【機能】 カテゴリシートでカテゴリを選択し、メニューシートへ遷移します。 この遷移時に、カテゴリ名をその他20シートのオートシェイプに反映させた状態で、 メニューシートを表示したいのです。 以下のマクロでそれは実現しました。 しかし、20シート中数シートで、オートシェイプのテキストが更新されていない場合がありました。 この場合、「カテゴリ名表示」のオートシェイプをクリックすることにより、 オートシェイプのテキストが更新されます。 なぜ、クリックしないと更新されないのでしょうか。 以下のマクロでのテキスト代入後、再度オートシェイプをselectするようにするなど、 そういった1文を追加してみたりしましたが、変化はありませんでした。 '================================================================== '== '各シートのオートシェイプ「カテゴリ名表示」にカテゴリ名をセット '================================================================== カテゴリ名 = カテゴリシート..Range("A1").Value For Each sht In Worksheets If sht.Visible = True Then sht.Activate For Each objShp In ActiveSheet.Shapes 'カテゴリ名表示というオートシェイプがあるかチェック If objShp.Name = "カテゴリ名表示" Then '存在すれば、カテゴリ名をセット sht.Shapes("カテゴリ名表示").Select Selection.Characters.Text = カテゴリ名 End If Next End If Next '================================================================== 以上、原因をご存じの方や思い当たる節がある方、どうかご教示ください。 わかりにくい部分などがありましたら、ご指摘いただければ追記させていただきます。 よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- オートシェープをグルーピングして動作させたい
office365 ２つのオートシェープをグルーピングして図形を動作させたい 下記で kibanは平行四辺形のオートシェープ yajirushiは右向き矢印のオートシェープ で、それぞれ、ある範囲で左から右に移動を繰り返します。 この２つのオートシェープをグルーピングして 平行四辺形の右側に矢印を配置した状態で、そのグルーピングされた図形の動作を繰り返す様にしたいのですが、 その内容が分からないのでコードで教えていただきたく、よろしくお願いします。 #If Win64 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else ' Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Sub kiban() shape_delete Dim ws2 As Worksheet Dim i As Integer Set ws2 = Sheets("sheet1") ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 354, 46, 20).Select With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 176, 80) .Transparency = 0 .Solid End With ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 458, 20, 20).Select ws2.Shapes(ws2.Shapes.Count).name = "kiban" For i = 0 To 30 If i = 30 Then i = 0 End If ws2.Shapes(1).Left = i * 3 + 365 ws2.Shapes(1).Top = 458 Sleep 100 DoEvents Next i ws2.Shapes("kiban").delete End Sub Sub yajirushi() shape_delete Dim ws As Worksheet Dim i As Integer Set ws = Sheets("sheet1") ws.Shapes.AddShape msoShapeRightArrow, 2265, 458, 20, 20 ws.Shapes(ws.Shapes.Count).name = "yajirushi" For i = 0 To 30 If i = 30 Then i = 0 End If ws.Shapes(1).Left = i * 3 + 420 ws.Shapes(1).Top = 458 Sleep 100 DoEvents Next i ws.Shapes("yajirushi").delete End Sub Sub shape_delete() Dim shp As Shape Dim rng As Range Range("P22:CM28").Select If TypeName(Selection) <> "Range" Then Exit Sub For Each shp In ActiveSheet.Shapes '‘ 図形の配置されているセル範囲をオブジェクト変数にセット Set rng = Range(shp.TopLeftCell, shp.BottomRightCell) '‘ 図形の配置されているセル範囲と '‘ 選択されているセル範囲が重なっているときに図形を削除 If Not (Intersect(rng, Selection) Is Nothing) Then shp.delete End If Next End Sub
- ベストアンサー
- Excel（エクセル）
- オートシェイプについて
すいませんが、オートシェイプについて教えてください。 同じオートシェイプを複数描くにはどうすればよいのでしょうか？たとえば、基本図形から円を選択して引きます。つづけて、円を再度引きたい場合、また基本図形から円を選択して引くしか方法はないのでしょうか？ 一度選択した図形を連続して描く方法を教えてください。
- 締切済み
- オフィス系ソフト
- ワードにてオートシェイプ の修正(選択できない)
オートシェイプ の修正 はどうしたらいいのでしょうか？ オートシェイプを選択して修正できるのは分かるのです。ただ、使ってる書類には文字や線が一杯でマウスをいくら細かく動かしても選択できないのです（文字や線にいってしまう） そこでマウスを使わないで選択する方法（そのほかにもあれば）、をご教授いただけませんでしょうか。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでオートシェープのRectangleの選択
しょうもない質問ですが、不思議なので教えてください。 エクセル2000です。 ワークシート上に配置したオートシェープのTypeNameを取得してみると、線（Line）、楕円（Oval）以外は四角形も八角形も星型もみんなRectangleでした。 ところが、 ActiveSheet.Rectangles.Select としてみても、選択されるのは四角形と丸四角形のみです。 もちろん、Lines.Select や、Ovals.Select で選択できるのは、線 と 楕円 だけです。 八角形も星型もみんなTypeNameはRectangleなのに四角形と丸四角形以外のRectangleはどうして選択できないのでしょうか？ Sub testRectangle() For Each o In ActiveSheet.DrawingObjects If TypeName(o) = "Rectangle" Then o.Select (False) Next End Sub とやれば、Rectangleだけ選択は出来ますが、ループしないで一括で選択はできないのでしょうか？
- 締切済み
- オフィス系ソフト
お礼
keithinさん、毎回ありがとうございます。 無事できました。 MSのヘルプは長すぎる上に、わかり辛過ぎてちょっと難しいですね……。