[[20190418120636]]　『範囲内シェイプの削除でのエラー1004について』（なつ）　ページの最後に飛ぶ

『範囲内シェイプの削除でのエラー1004について』（なつ）

エラーになる時とならない時があり、VBA初心者の為、エラー特定の切り分けをしようにも知識が乏しく、切り分け方だけでもいいので、どなたかお助け頂けませんでしょうか。

実際の作業は簡略記載すると、
1,ボタン1押下でA3:F5結合セルに値を代入
2,ボタン2押下で範囲内(O11:T17)のシェイプを削除後、名前を付けて保存

ボタン2のシェイプ削除+保存動作でエラーが出る時があります。
該当部は、

Set rng = Range("O11:T17")
For Each shp In ActiveSheet.Shapes
If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), rng) Is Nothing Then
shp.Delete
End If
Next

を実行すると正常な時とエラーになる時があります。

エラーは「アプリケーション定義またはオブジェクト定義のエラーです：1004」
になります。
エラー箇所は「if Not~」の行で、
ステップインで確認すると、範囲内の最後のシェイプを全て削除した後、シェイプが無くなった後にNextに進まずエラーが表示されます。
エラーにならずnextに進める時もあります。

エラー時と、正常時の違いを切り分けてみたところ、
同シート内のA3:F5結合セルに入力規則でリスト選択できるセルがあるのですが、実行前にそのセルを一度でも選択した経緯があるとエラーが発生します。

入力規則の無い通常セル(ex.C10)などに、通常入力しただけでは発生せず、入力規則が絡んでいるのかもしれませんが、知識が無く詰まってしまいました。

＜正常>
ボタン1押下後にそのままボタン2押下 or　C10などA3:F5結合セル以外の他セルに手動入力後にボタン2押下は正常動作で保存できます。

＜エラー＞
ボタン１押下後にA3:F5結合セルを選択。リストの値を変更してもしなくても、一度でも結合セルを選択してしまうと、ボタン2押下後、先述エラーになります。

だったのですが、別ファイルでA3:F5セルを選択経緯を残した状態で上書き保存後に、実行すると毎回エラーが出るようになってしまいました。

A3:F5セル選択動作が悪さをしている気がするのですが、確定もできずお知恵を御貸し頂けないでしょうか。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 入力規則のドロップダウンの▽ボタンもシェイプなのだが一度も使っていない場合には存在せず
 （ActiveSheet.Shapes.Countとしても数に入っていない）
 一度でも表示させるとその時点で数に入ってくるようだ。
 もっともそれが影響しているかどうか、影響しているとするとどう影響しているかは不明だが。
（ねむねむ） 2019/04/18(木) 13:16

ねむねむ様
ありがとうございます。

試しに、まずA3:F5セルを触らずに、全セル選択後に入力規則を削除してから、A3:F5セルに手入力して、実行したところ、エラー発生しませんでした。

やはり入力規則絡み(ドロップダウン)辺りが影響しているとは思われるのですが、原因がわかりませんでした。

何か他に原因を特定していく方法などが思いつくようであれば教えて頂けましたら幸いです。

ありがとうございました。
（なつ） 2019/04/18(木) 18:07

切り分けの為にもっと簡素化したデータで試してみました。
やはり同様のエラーが発生します。

sheet1のA1セルに入力規則を設定
sheet1のE3からJ11の範囲内にテキストボックス、四角、直線、イメージなどを適当に設置
sheet2のA1~A9に（テスト1~9)のリスト元データを入力

A1の入力規制設定
・入力値の種類＝リスト
・元の値（OFFSET(sheet2!A$1,0,0,COUNTA(sheet2!A:A)-1,1)

VBA内容

Dim wb As Workbook
Dim rng As Range
Dim shp As Shape
Set wb = ThisWorkbook
wb.Worksheets("sheet1").Range("E3:J11").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

MsgBox "OK"

End Sub

一度もA1セルを触らずに実行すると「OK」まで進みます。
一度でもA1セルを触ると、シェイプは全て削除されますが、forを抜けられずエラーになります。

どなたか原因お分かりになりませんでしょうか？

（なつ） 2019/04/18(木) 18:34

自己解決できました。

細かい部分はわかりませんが、
やはり、ドロップダウンが追加されている事で、eachのシェイプに含まれてしまい、
それがエラーの原因になっているようでした。
適切なやり方かはわかりませんが、
she.nameで"Drop Down"を除外する分岐を入れた事で正常に動作しました。

ねむねむ様のアドバイスのおかげで思いつけました。
ありがとうございました。

Sub テスト()

Dim wb2 As Workbook
Dim rng As Range
Dim shp As Shape

Set wb2 = ThisWorkbook

wb2.Worksheets("sheet1").Range("E3:J11").Select

                    If TypeName(Selection) <> "Range" Then Exit Sub

                        For Each shp In ActiveSheet.Shapes

                          If Left(shp.Name, 9) <> "Drop Down" Then

                            Set rng = Range(shp.TopLeftCell, shp.BottomRightCell)

                                If Not (Intersect(rng, Selection) Is Nothing) Then
                                shp.Delete
                                End If

                          End If

                        Next

MsgBox "OK"

End Sub

（なつ） 2019/04/18(木) 19:20

 入力規則のドロップダウンオブジェクトは「TopLeftCell」の情報が持てないタイプなんだと思います。

 なので、当該ドロップダウンは、この処理の対象外にすればいいと思います。

     Dim rTest As Range
     For Each shp In ActiveSheet.Shapes

         Set rTest = Nothing
         On Error Resume Next
             Set rTest = shp.TopLeftCell
         On Error GoTo 0

         If Not rTest Is Nothing Then
             If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), Rng) Is Nothing Then
                 shp.Delete
             End If
         End If
     Next

（半平太） 2019/04/18(木) 19:48

これでも、よいかもしれません。

    For Each shp In ActiveSheet.DrawingObjects
        If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), Rng) Is Nothing Then
            shp.Delete
        End If
    Next

（マナ） 2019/04/20(土) 13:26

コメント返信：

[ 一覧(最新更新順) ]

[[20190418120636]] 『範囲内シェイプの削除でのエラー1004について』（なつ） ページの最後に飛ぶ

[[20190418120636]]　『範囲内シェイプの削除でのエラー1004について』（なつ）　ページの最後に飛ぶ