ExcelVBA グループ化でエラーが出る時がある

このQ&Aのポイント
  • ExcelVBAでオートシェイプを作成し、グループ化するマクロを作成しています。しかし、グループ化する際に「指定した名前のアイテムが見つかりませんでした」というエラーが発生します。
  • エラーが発生した場合、一度マクロを中止し、画面上に作成したオートシェイプを表示させてから再度マクロを実行すると、エラーが解消されることがあります。しかし、エクセルを一度閉じて再度開くと、またエラーが発生します。
  • グループ化の前に「ws_This.Shapes(str_Shape(1)).TopLeftCell.Select」を使用して画面の表示を変更しても、同様のエラーが発生します。さらに、新しいブックにコードをコピーして実行しても、エラーが発生します。再現性のある簡単なコードを作成してもエラーが再現しないため、問題の原因と解決方法が分かりません。
回答を見る
  • ベストアンサー

ExcelVBA グループ化でエラーが出る時がある

オートシェイプを作成し、それをグループ化するマクロを作ろうとしています。 ところが、グループ化する際に、「指定した名前のアイテムが見つかりませんでした」というエラーが出る時があります。 ・やり方は、AddShapeでオートシェイプ作成⇒str_Shape()に作成したオートシェイプの名前を格納⇒ws_This.Shapes.Range(str_Shape).Groupでグループ化させようとしています(ws_Thisは作業対象シート)。 ・エラーが出た際、マクロを一旦中止し、画面上に作成したオートシェイプを表示させてから再度マクロを実行すると、大抵エラーが出なくなります。 ・エラーが出なくなっても、エクセルを一度閉じて再度開くと、またエラーが出ます。 ・エラーが出る箇所のコードは「Set shape_G = ws_This.Shapes.Range(str_Shape).Group」です。  ウォッチ式で確認した所「ws_This.Shapes.Range(str_Shape(13)).Name」で「<指定した名前のアイテムが見つかりません>」というエラーが出ていましたが、「str_Shape(13) = ws_this.Shapes.Range(90).Name」だとtrueが返りました。 ・グループ化の前に「ws_This.Shapes(str_Shape(1)).TopLeftCell.Select」で画面の表示を変更させてみても同様のエラーが出ました。 ・新しいブックにコードをコピーして実行しても、同様にエラーが出ました。 ・再現できるか簡単なコードを組んでみましたが、エラーの再現はできませんでした。 shapesオブジェクトで、存在する名前で指定してもオブジェクトが見つからない、という問題だと思うのですが、なぜこうなるのか、どうすれば解決するのかが分かりません。 現状、一応マクロを使えるのですが、最初にエラーを出させて、画面を動かして……という手間がかかりますので、解決できるなら解決したいと思います。 どうか皆様のお知恵をお貸しください。 バージョンはWindows7pro Excel2010互換モードです。

質問者が選んだベストアンサー

  • ベストアンサー
  • m3_maki
  • ベストアンサー率64% (295/459)
回答No.1

Shape.GroupItems プロパティ https://docs.microsoft.com/ja-jp/office/vba/api/Excel.Shape.GroupItems 上記の「例」を実行後、イミディエイトウィンドウで確認。 ? activesheet.shapes.count 1 ? activesheet.shapes(1).name Group 4 ? activesheet.shapes(1).groupitems.count 3 ? activesheet.shapes(1).groupitems(2).name shpTwo ? activesheet.shapes(1).groupitems("shpTwo").name shpTwo 以上、参考まで。

Mathmi
質問者

お礼

回答ありがとうございます。 「グループ化した個々のshapeはShape(n)では呼び出せず、Shape(n).GroupItem(m)という形で呼び出さなければならない」という事ですね。 フォルダ階層のような、ツリー状で管理されている、と。 (なお、名前からなら activesheet.shapes("shpTwo").name で、階層関係なく呼び出せました)

Mathmi
質問者

補足

オートシェイプ名を全て書き出して調べてみましたが、重複はありませんでした。 グループ化したオートシェイプ、str_Shape(12)/Group18も ws_This.Shapes.Range(str_Shape(12)).Nameでエラーは出ていません。 ただし、str_shape(2)~str_shape(8)でエラーが出ています。これらはグループ化していません。 既存のオートシェイプが問題かと思い、削除したり色々してみた所、グループ化を一段階解除したら、エラーが出なくなりました。 グループ化してあるオートシェイプはまだありますが、グループ化したものをグループ化はもうしていません。 解除したものをもう一度グループ化すると、再度エラーが出るようになったので、グループ化が問題なのかと思います。 それにしては、エラーが出る箇所がGroupではないのが不明ですが。

関連するQ&A

  • 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

  • ExcelVBA オートシェイプについて

    セルの選択した場所のとなりにオートシェイプを移動させるマクロを組みたいと思っています 見かけがまったく同じシートが4枚あり、そのシート全てに同じマクロを指定したいのですが、オートシェイプの名前の指定の仕方が分からなく困っています SelectionChangeイベントでオートシェイプ移動のマクロを動かしているので、同じ名前のボタンならよいのですが・・・ なにかよい方法はないでしょうか?

  • 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 = "文字列" とするとエラーが出てしまいます。グループ化されたオートシェイプのテキスト編集は、一度グループを解除し、それぞれテキスト編集しなければならないのでしょうか? 回答よろしくお願いします。

  • 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 ------------------------------------------------- このマクロは全体の一部分になりますが、(1)のところでエラーになります。 どこが間違っているのか、さっぱりわかりません。 すみませんが、お助けいただければ幸いです。

  • オートシェープをグルーピングして動作させたい

    office365 2つのオートシェープをグルーピングして図形を動作させたい 下記で kibanは平行四辺形のオートシェープ yajirushiは右向き矢印のオートシェープ で、それぞれ、ある範囲で左から右に移動を繰り返します。 この2つのオートシェープをグルーピングして 平行四辺形の右側に矢印を配置した状態で、そのグルーピングされた図形の動作を繰り返す様にしたいのですが、 その内容が分からないのでコードで教えていただきたく、よろしくお願いします。 #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

    EXCELの指定した範囲(例えばrange("A1:C5"))にある オートシェイプ 図 テキストボックス を選択しグループ化するためには どのようにコードを記述すればいいでしょうか

  • 特定の名前のオートシェイプの有無を知りたい(エクセルVBA)

    Excel VBA で、オートシェイプを扱おうとしています。 たとえば、 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 50, 50).Name = "TestShape1" のようにして、それぞれ名前を付けているのですが、プログラム中、特定のオートシェイプを削除したり、再び同じ名前で作ったり、ということを行っています。 前者の場合、すでに当該オートシェイプが削除されている場合、目的のオートシェイプが存在していないためか、エラーが発生します。また後者の場合も、オートシェイプを重ねて作成することになってしまうケースにエラーが発生します。 On Error Resume Next で回避することも考えられるでしょうが、もっと直接的に、ある名前のオートシェイプが存在する/しない、をチェックしたうえで各処理を行うようにしたいのです。 どのような方法があるでしょうか?

  • ExcelVBAでのエラー処理について

    Excel2003のVBAでマクロを作成しています。 On Error Gotoを使用して開こうとしたブックを開こうとして目的のブックがなかった場合のエラー処理コードを書いたのですがうまくエラー処理行に飛んでくれず、実行時エラーのメッセージがでてマクロがとまってしまいます。 コードを見返したところ記述ミスはないようなのですが、考えられるミスは何なのでしょうか?

  • Excel VBA CHAR( ) でエラーになる

    Excel VBA でマクロ処理を作成してます。 現在エラー直らず困っています。 処理は内容は以下になります。 セルを指定 →『Q11』選択 offset() で+1して列を右に1個移動 で、選択したセルには今計算式が入っているが… その計算式を修正する 修正前  修正後 Q11/3 → Q11 オートフィルでセルの最下位まで確定させる その後,列を右に3コ移動して (offset関数を使用して移動してます) 後はfor文で繰り返せ…  といった処理で,以下がソースになります。 Sub test() Dim str As String n = 1 For i = 1 To 2 Range("Q11").Select.Offset(, n).Select ▲ActiveCell.FormulaR1C1 = "=RC[123]" ★str = CHAR(CODE("Q") + n) Selection.AutoFill Destination:=Range(str & "11:" & str & "160") n = n + 3 Next End Sub ★マークで現在エラーになっている様です。 関数の使用方法が間違っているのか? エラーが直らず困っています。 ▲マークもあまりよくない記述かもしれませんが…試しマクロで作成してコピーしただけのものなので…この辺りもよい記述があればご教授ください。 アドバイス宜しくお願いします。

  • ボタン作成について

    オートシェイプの上にマクロのボタンを作成しました。それを他の場所に動かすとオートシェイプのみ動き、マクロのボタンはそのままの位置です。グループ化をしようとしましたが無理でした。オートシェイプの上にマクロのボタンを置きたいのですが、どうすればいいですか?

専門家に質問してみよう