プロが教える店舗&オフィスのセキュリティ対策術

Worksheet上には、楕円図形+テキストで作られたまたは、エクセル用無料判子アプリで作った、判子オブジェクトが1ケ~複数個あります。
他の図形やマクロボタンもありますが、それは選択の対象外で、判子オブジェクトだけ消したいのです。
アクティブシートに存在する判子オブジェクトのみを選択し、オブジェクトのタイプがオートシェイプまたは、画像であるか判定し、それら選択したオブジェクトを削除する。というシナリオで見様見真似で書いてみた以下のコードではおかしいのですが、どうおかしいかわかりません。

Sub AutoShapeDel()

Dim objShape As Object
Dim arr() As String
ReDim Preserve arr(0)

For Each objShape In ActiveSheet.Shapes
arr(UBound(arr)) = objShape.name
If objShape.Type = msoAutoShape Then
arr(UBound(arr)) = objShape.name
ReDim Preserve arr(UBound(arr) + 1)
End If

Next
ReDim Preserve arr(UBound(arr) - 1)
ActiveSheet.Shapes.Range(arr).Select
Selection.Delete

For Each objShape In ActiveSheet.Shapes
arr(UBound(arr)) = objShape.name
If objShape.Type = msoPicture Then
arr(UBound(arr)) = objShape.name
ReDim Preserve arr(UBound(arr) + 1)
End If

Next
ReDim Preserve arr(UBound(arr) - 1)
ActiveSheet.Shapes.Range(arr).Select
Selection.Delete

End Sub

どなたかこの不出来なコードをなんとか動くコードにしていただけないでしょうか?

A 回答 (3件)

No2です。



>複数のmsoPictureにはどうすればいいかです。もしよろしければ、
>そこの部分をご解説いただけますと幸いです。
「判子オブジェクト」というのは画像ということですね?
で、他の(=判子以外の)画像と区別したいということでしょうか?
一般的な、属性だけで区別しようというのは難しいと思います。
こちらではわかりかねますが、何か「判子オブジェクト」固有の特徴を探すしかないのではないでしょうか。

どうしても特徴がないとなると、
・判子オブジェクトのピクセルサイズ
 (サイズはエクセル上で可変ですが、固定ピクセルではないかと想像)
・画像の構成色を調べる
 (多分、「赤と白」、あるいは「赤と透明」のみと想像)
あたりを手掛かりにするしかないような気がします。
(これだけでは確実とは言えませんが、ある程度の精度はでるかも知れません)

検索していたら、画像の色構成を調べるのに便利そうなDLLを作成している方のページを発見しましたので、ご参考までに。(win7時代のDLLのようですが・・)
https://mamesan.com/image/image_viewer_j.html
    • good
    • 0
この回答へのお礼

画像の構成色のヒントありがとうございました。
調べてみます。

お礼日時:2022/03/19 10:40

こんばんは



コードの前に、そもそも論になってしまいますが・・・

>判子オブジェクトだけ消したいのです。
シート上には他のShapeも存在するようですが、現状で正しく識別できているのでしょうか?

>If objShape.Type = msoAutoShape
の判定だけでは、「図の挿入」で作成される図は全て該当してしまいますが、それで問題はないのでしょうか?

例えば、「他の図形やマクロボタン」と言うのが、矢印線や矩形や星形などということはありませんか?
(これらは、そのままだと上記の判定にヒットします)
あるいは、ボタンに角丸の矩形を用いていることはないでしょうか?
(フォームボタンよりも、色を付けたり立体的に表示したりしやすいので)

また、
>エクセル用無料判子アプリで作った、判子オブジェクト
というのがどのようなものかわかりませんが、図形等がグループ化されていたりしませんか?
(グループ化されていると、上記の判定ではスルーされると思います)

特に、「楕円図形+テキスト」で作成された「判子状の図形」を他の図形と区別することは、かなり難しそうな気がしますけれど・・・


※ いらぬお節介的な杞憂なので、既に解決済みであるのなら無視してください。
    • good
    • 1
この回答へのお礼

こんばんは。
気にかけてくださりありがとうございます。
エクセル用無料判子アプリで作った、判子オブジェクトは、1ケしか存在しない場合は、msoPictureでヒットし、消すことができました。マクロボタンは、フォームのコントロールですし、今のところ他のAutoShapeの図形はないので、(今後の可能性がありますが・・) とりあえずmsoPictureの判定で進めようと思います。
今直面している最大の問題は、複数のmsoPictureにはどうすればいいかです。もしよろしければ、そこの部分をご解説いただけますと幸いです。

お礼日時:2022/03/18 23:26

ザックリしか見ていませんが、


For Each objShape In ActiveSheet.Shapes
arr(UBound(arr)) = objShape.name ’←必要?
If objShape.Type = msoAutoShape Then
arr(UBound(arr)) = objShape.name
ReDim Preserve arr(UBound(arr) + 1)
End If

ActiveSheet.Shapes.Range(arr).Select
Selection.Delete
ここで、
ActiveSheet.Shapes.Range(arr).Select
が可能であれば、「objShape.Type = msoAutoShape」に合致するものは全て削除されているはずです。
その後、arr()をreset?していないので、
UBound(arr)はそのままの大きさです。
それでよろしいのでしょうか?
    • good
    • 0
この回答へのお礼

ご指摘ありがとうございます。
arr(UBound(arr)) = objShape.name を消してみます。

お礼日時:2022/03/18 16:18

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!