![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
EXCELで、ある範囲の図形を選択するマクロが組みたいのですが、
マクロの自動記録でオブジェクトの選択ボタンで範囲指定をすると、
マクロ自体はPicture4,Picture5,…というように
各図形として判断しているようで、範囲内の選択というわけにはいかないようで困っています。
私がやろうとしているのは、すでにひとつの図形(日本地図)があり、
その上に貼り付けられた図(都市の写真)のみ選択したいのです。
選択したい図(都市の写真)の名前は都度かわるため、Picture4,Picture5,…となると、別の名前のものが貼り付けられたときに認識しないので困るのが一点、もう一点は、既に地図が貼り付けられた状態で、この地図自体は選択には入れないで地図の内側の範囲内にある都市の写真のみを選択したいという二点が課題で・・どうしたらよいものか困っています。
A 回答 (5件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
>写真の中にグループ化されていた写真が混じっていました。
確かに、グループ化された写真が混じっていると、
エラーになりますね。気が付きませんでした。
画像が存在するときにも「地図上に画像が存在しません。」の
メッセージが出る件ですが、
エラーが無いときは ErrorHandler:以下が実行されないように、
Exit Sub でプロシージャを抜ける必要があります。
以下のような感じでしょうか。
Sub 地図上の画像選択1_1()
Dim r1 As Range
Dim r2 As Range
Dim p As Picture
Dim ary() As String
Dim i As Integer
i = 0
With ActiveSheet.Pictures("Picture 3")
Set r1 = Range(.TopLeftCell, .BottomRightCell)
End With
For Each p In ActiveSheet.Pictures
Set r2 = Range(p.TopLeftCell, p.BottomRightCell)
If Not Application.Intersect(r1, r2) Is Nothing And p.Name <> "Picture 3" Then
ReDim Preserve ary(i)
ary(i) = p.Name
i = i + 1
End If
Next
Set r1 = Nothing
Set r2 = Nothing
On Error GoTo ErrorHandler:
ActiveSheet.Pictures(ary).Select
Exit Sub '←この1行を追加
ErrorHandler: MsgBox "地図上に画像が存在しません。"
End Sub
ありがとうございます!!!
できましたっっ(*^o^*)
この度は本当にいろいろと教えていただき、ありがとうございます。
ぶ厚い本を購入していろいろ読んだのですがなかなか思い通りにいかず
すごく困っていたのですが、お蔭様で完成しました♪
これで仕事がスムーズに捗ります!
もぅ何とお礼を申し上げてよいやら・・というほど感動です!
本当にありがとうございました!
No.4
- 回答日時:
>Picturesクラスのselectメソッドに失敗しました。
ごめんなさい。
正直言って実際のシートを見てみないことには
エラーの理由はわかりません。
(見てもわからないかもしれませんが・・・)
あてずっぽうですが、シートを保護しているとかありませんか?
お礼が遅くなって申し訳ありません。
エラーの原因が何かよくわからなくて何度もやっていたら
写真の中にグループ化されていた写真が混じっていました。
エラーの原因はそれだったようです。
お手数おかけしました。
ありがとうございました。
実は今、マクロを登録した画像選択ボタンを作ったのですが、
もしも地図上に画像(都市の写真)が1枚も存在しなかったときに
エラーが出てしまいます。
もし都市の写真が1枚も存在しないのに画像選択ボタンを押してしまったら「地図上に画像が存在しません。」というメッセージを表示させたくて本を見ながら入れてみたのですが・・・うまくいきません。なぜか画像が存在するときにもこのメッセージが表示されます。。。
やはりエラー処理の入れ方が間違っているのでしょうか?
もしよろしければアドバイスをいただけると助かります。
本当にすみません。
Sub 地図上の画像選択1_1()
Dim r1 As Range
Dim r2 As Range
Dim p As Picture
Dim ary() As String
Dim i As Integer
i = 0
With ActiveSheet.Pictures("Picture 546")
Set r1 = Range(.TopLeftCell, .BottomRightCell)
End With
For Each p In ActiveSheet.Pictures
Set r2 = Range(p.TopLeftCell, p.BottomRightCell)
If Not Application.Intersect(r1, r2) Is Nothing And p.Name <> "Picture 546" Then
ReDim Preserve ary(i)
ary(i) = p.Name
i = i + 1
End If
Next
On Error GoTo ErrorHandler:
ActiveSheet.Pictures(ary).Select
Set r1 = Nothing
Set r2 = Nothing
ErrorHandler:MsgBox"地図上に画像が存在しません。"
End Sub
No.3
- 回答日時:
> 作業とは別に
> この選択した図を削除するには「Delete」をどこかにつけなければ
> いけないのだと思うのですが、どこにつければよいでしょうか?
「この作業と別」 ということですが、選択が目的ではなく、削除だけの場合は、
コード上の削除する時点が変わってきます。
◎ 先のように該当する図形を選択し、MsgBoxで「削除するか?」にYesを選択した
場合は、削除し、Noを選択した場合は、選択状態のままにするのであれば、
こんな感じです。(先のコードにDeleteを付加する)
Sub 範囲内図形削除()
Dim Pic As Picture
Dim Rng As Range
Dim Cnt As Long
If TypeName(Selection) = "Range" Then
Set Rng = Selection
For Each Pic In ActiveSheet.Pictures
If Not Intersect(Rng, Pic.TopLeftCell) Is Nothing Then
If Not Intersect(Rng, Pic.BottomRightCell) Is Nothing Then
If Cnt = 0 Then
Pic.Select
Else
Pic.Select (False)
End If
Cnt = Cnt + 1
End If
End If
Next
If Cnt = 0 Then
MsgBox "該当する図形は、見つかりません。", vbExclamation
Else
If MsgBox(Cnt & " 個の図形が見つかりました。" & String(2, vbLf) & _
"削除しますか?", vbYesNo + vbQuestion) = vbYes Then Selection.Delete
End If
Else
MsgBox "セル範囲を選択してください。"
End If
Set Rng = Nothing
End Sub
◎ 該当図形を選択せず、即 削除する場合は、こんな感じです。
Sub 範囲指定図形削除()
Dim Pic As Picture
Dim Rng As Range
Dim Cnt As Long
If TypeName(Selection) = "Range" Then
Set Rng = Selection
For Each Pic In ActiveSheet.Pictures
If Not Intersect(Rng, Pic.TopLeftCell) Is Nothing Then
If Not Intersect(Rng, Pic.BottomRightCell) Is Nothing Then
Pic.Delete
Cnt = Cnt + 1
End If
End If
Next
If Cnt = 0 Then
MsgBox "該当する図形は、見つかりません。", vbExclamation
Else
MsgBox Cnt & " 個の図形を削除しました。"
End If
Else
MsgBox "セル範囲を選択してください。"
End If
Set Rng = Nothing
End Sub
コードを解析して、実情に合わせた形のコードにされたら良いと思います。
ありがとうございます。
該当図形を選択せず即削除の方法で行わせていただくことにしました。
わがままを言ってお手数をおかけしました。
すごく助かりました。
本当に感謝です!
No.2
- 回答日時:
こんにちは。
日本地図の名前を "Picture 1" として、
この日本地図と少しでも重なっている、
その他の図を全て選択するとして、
Sub Sample()
Dim r1 As Range
Dim r2 As Range
Dim p As Picture
Dim ary() As String
Dim i As Integer
i = 0
With ActiveSheet.Pictures("Picture 1")
Set r1 = Range(.TopLeftCell, .BottomRightCell)
End With
For Each p In ActiveSheet.Pictures
Set r2 = Range(p.TopLeftCell, p.BottomRightCell)
If Not Application.Intersect(r1, r2) Is Nothing And p.Name <> "Picture 1" Then
ReDim Preserve ary(i)
ary(i) = p.Name
i = i + 1
End If
Next
ActiveSheet.Pictures(ary).Select
Set r1 = Nothing
Set r2 = Nothing
End Sub
この回答への補足
昨日はありがとうございました。
実は、教えて頂いたとおりにコードを貼り付け使用しているのですが、
日本地図上にある都道府県の写真を日本地図の横にある
文章のあたりに移動して、改めて『日本地図上にある都道府県の写真のみ選択』を実行すると、「ActiveSheet.Pictures(ary).Select」のところでどうしてもエラーになってしまいます。
エラーになるのは、
都道府県の写真を横の文章のあたり1~3枚移動した場合のみ
(4枚以上を移動した場合にはエラーはでません)
エラーの内容は、
実行時エラー1004
Picturesクラスのselectメソッドに失敗しました。
もし教えて頂けると助かります。
お手数おかけして申し訳ありません。
ありがとうございます。
私の思い通り図を選択することができました。
初心者の私でも希望通りのことができそうです。
本当に本当に助かりました。
本当にありがとうございました!
No.1
- 回答日時:
セルを選択し、その中にスッポリ入っている図形を選択する ということで
宜しければ、こんな感じで如何でしょうか。
もし、セル選択範囲に図形の左上隅だけが入っているものだけを選択したい場合は、
後の If Not Intersect ~ と対応する End If を削除します。(9、16行目)
Sub 範囲内図形選択()
Dim Pic As Picture
Dim Rng As Range
Dim Cnt As Long
If TypeName(Selection) = "Range" Then
Set Rng = Selection
For Each Pic In ActiveSheet.Pictures
If Not Intersect(Rng, Pic.TopLeftCell) Is Nothing Then
If Not Intersect(Rng, Pic.BottomRightCell) Is Nothing Then
If Cnt = 0 Then
Pic.Select
Else
Pic.Select (False)
End If
Cnt = Cnt + 1
End If
End If
Next
MsgBox Cnt & " 個の図形を選択しました。"
Else
MsgBox "セル範囲を選択してください。"
End If
Set Rng = Nothing
End Sub
ありがとうございます。
とても助かります。
実は、私が行おうとしている日本地図上の作業とは別に
あるセル範囲内での図形の削除というのもしなければならなかったので
そちらもすごく悩んでいたのですが、
こちらの方法を使わせていただきたいと思います。
ご親切に教えて頂けて、本当に嬉しいです。
この選択した図を削除するには「Delete」をどこかにつけなければ
いけないのだと思うのですが、どこにつければよいでしょうか?
重ね重ねすみません。
もし教えていただければ助かります。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) ログインIDの一発入力? 5 2023/07/07 12:30
- Excel(エクセル) 余計なお世話的な「入力規則」?対策は? 2 2023/01/14 12:39
- Excel(エクセル) エクセルのマクロを教えてください。 4 2022/10/06 08:53
- その他(Microsoft Office) ワードのマクロについて教えてください。 1 2023/01/22 11:43
- PDF PDFの表がエクセルに貼り付けられなくなってしまいました。 5 2022/06/03 09:07
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- PowerPoint(パワーポイント) パワーポイントの図をWordへ貼り付け 1 2022/11/09 21:28
- Excel(エクセル) Excel 数式を使用した条件付き書式が、一つのセルにしか反映されない 3 2022/06/08 23:20
- Excel(エクセル) エクセルVBA 複数行にまたがっている選択を判定するには 2 2023/05/21 21:54
- その他(Microsoft Office) 選択行の列範囲に二重線を引く 3 2022/06/08 12:21
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
指定範囲内で図形等を削除する...
-
エクセルで図形やワードアート...
-
Excel組織図を横に展開する方法...
-
Office365 のExcelでオブジェク...
-
word2010 SmartArtで連絡網作...
-
jwCAD 登録した図形を呼び出し...
-
ある範囲の図形を選択
-
Excel 図形を移動させると複写...
-
Excel に貼り付けた図形が、勝...
-
ExcelのVBAコードについて教え...
-
JWCADの図形登録について
-
エクセル マクロで、選択してい...
-
パワーポイント(2016)、線を...
-
イラストレーターのクリッピン...
-
マウスで選択した図形のみVBAで...
-
WINDOWSのペイントの使い方
-
オートシェイプで任意のドーナ...
-
EXCEL セルに配置した図形ごと参照
-
ワードで大量の図形を一括でグ...
-
イラレCSでハッチ効果ありますか?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで図形やワードアート...
-
指定範囲内で図形等を削除する...
-
word2010 SmartArtで連絡網作...
-
Office365 のExcelでオブジェク...
-
Excel に貼り付けた図形が、勝...
-
Excel組織図を横に展開する方法...
-
jwCAD 登録した図形を呼び出し...
-
Excel 図形を移動させると複写...
-
マウスで選択した図形のみVBAで...
-
オートシェイプで任意のドーナ...
-
エクセル マクロで、選択してい...
-
マクロで選択した図形の選択状...
-
ベクターワークスで線を複写
-
パワーポイント(2016)、線を...
-
ワードの図形をコピー&ペイス...
-
エクセル コマンドボタン 丸...
-
ワードで大量の図形を一括でグ...
-
PowerPoint2013で、図形の枠線...
-
EXCELでのデータ及び図形...
-
ExcelのVBAコードについて教え...
おすすめ情報