Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4053 / 13644 ツリー ←次へ | 前へ→

【58638】オートシェイプを消すマクロがわかりません りー 08/11/2(日) 1:27 質問[未読]
【58640】Re:オートシェイプを消すマクロがわかりま... かみちゃん 08/11/2(日) 7:44 発言[未読]
【58642】Re:オートシェイプを消すマクロがわかりま... りー 08/11/2(日) 11:56 お礼[未読]
【58643】Re:オートシェイプを消すマクロがわかりま... りー 08/11/2(日) 12:01 質問[未読]
【58644】Re:オートシェイプを消すマクロがわかりま... kanabun 08/11/2(日) 14:55 発言[未読]
【58645】Re:オートシェイプを消すマクロがわかりま... かみちゃん 08/11/2(日) 15:07 発言[未読]
【58647】Re:オートシェイプを消すマクロがわかりま... りー 08/11/2(日) 16:11 お礼[未読]
【58646】Re:オートシェイプを消すマクロがわかりま... りー 08/11/2(日) 16:03 お礼[未読]
【58648】Re:オートシェイプを消すマクロがわかりま... kanabun 08/11/2(日) 16:17 発言[未読]
【58649】Re:オートシェイプを消すマクロがわかりま... かみちゃん 08/11/2(日) 17:05 発言[未読]
【58650】Re:オートシェイプを消すマクロがわかりま... りー 08/11/2(日) 18:29 お礼[未読]

【58638】オートシェイプを消すマクロがわかりませ...
質問  りー  - 08/11/2(日) 1:27 -

引用なし
パスワード
   VBA初心者でどうすればいいのかわからず教えて頂きたいことがあります。

実行したいことはユーザーフォームの中のオプションボタンを選択するとエクセル上の指定位置にオートシェイプの楕円を表示させるというもので、そこまでは本を見ながら何とかできたのですが、一つ問題が起きました。
オプションボタンは2つあり(仮にA,Bとします)、Aを選択してマクロを実行した後にBに変更して再度マクロを実行するとAを選択したときのオートシェイプが残ったままになります。
マクロをリセットするような構文を入力していないので当然と言えば当然なのですが、その構文の書き方がわかりません。
結果として、最後に実行した分のオートシェイプだけが表示されるようにできればいいのですがよい方法があれば教えてください。

質問内容が分かりにくいかもしれませんが是非よろしくお願いします。

【58640】Re:オートシェイプを消すマクロがわかり...
発言  かみちゃん E-MAIL  - 08/11/2(日) 7:44 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> 最後に実行した分のオートシェイプだけが表示される

質問が少しわかりづらいのですが、以下のような感じでいかがでしょうか?

Sub Sample()
 Dim shp As Shape
 Dim i As Integer
 
 For i = ActiveSheet.Shapes.Count - 1 To 1 Step -1
  ActiveSheet.Shapes(i).Delete
 Next
 MsgBox "最新のオートシェイプ以外を削除しました" & vbCrLf & _
  "最新のオートシェイプは、" & ActiveSheet.Shapes(1).Name
End Sub

【58642】Re:オートシェイプを消すマクロがわかり...
お礼  りー  - 08/11/2(日) 11:56 -

引用なし
パスワード
   こんにちは。
かみちゃんさんありがとうございました。

教えて頂いたマクロでオートシェイプを消すことができました。
分かりにくい質問にも関わらず回答ありがとうございました。

【58643】Re:オートシェイプを消すマクロがわかり...
質問  りー  - 08/11/2(日) 12:01 -

引用なし
パスワード
   今回の質問に関連して今後のためにもう一つ知りたいのですが、
よろしければ教えてください。

今回はオプションボタンが2つから1つを選択するだけだったのですが、
同一のユーザーフォーム中に2者択一のオプションボタンが複数
あった場合、それぞれの選択に対してオートシェイプを表示し、
前回実行分のオートシェイプは消去するというようなことはできるの
でしょうか?

イメージとしては複数(10個程度)の2者択一に対してそれぞれ
オプションボタンを選択し、最後にコマンドボタンを押すと
複数のオートシェイプが表示され、それ以前のオートシェイプは
消去されるという風にしたいのです。

似たような質問で申し訳ありませんがよろしくお願いします。

【58644】Re:オートシェイプを消すマクロがわかり...
発言  kanabun  - 08/11/2(日) 14:55 -

引用なし
パスワード
   ▼りー さん:

こんにちは。ちょっとお邪魔します。

> 最後に実行した分のオートシェイプだけが表示されるように
> できればいいのですが

>あった場合、それぞれの選択に対してオートシェイプを表示し、
>前回実行分のオートシェイプは消去するというようなことはできるの
>でしょうか?

最初の質問と2回目の質問のちがいがよく分からないので、

まとめて、一般論ですが、、

描画して、最後に描画したオートシェイプ以外削除する のでなく、
現在のシート上のオートシェイプを消しておいてから、
目的のオートシェイプを描画すればいい、ような気がします。

あと、Shapesコレクションにはオートシェイプ以外にも、
グラフはもちろん、コメントや入力規則のドロップダウン▼や
オートフィルタをかけていれば、そのドロップダウン▼も含まれます。
ですから、
現在のシート上の「オートシェイプをすべて消してから」という
目的で、

 Dim shp As Shape
 Dim i As Integer
 
 For i = ActiveSheet.Shapes.Count To 1 Step -1
  ActiveSheet.Shapes(i).Delete
 Next

とやったりすると、コメントや入力規則リストまで削除されてしまい、
シートの構成によっては、以後使い物にならないシートに変わってし
まう恐れがあります。

Shapesコレクションではなく、
  ActiveSheet.DrawingObjects.Delete
というステートメントを使いましょう。

オプションボタンで描画しているのが、いつも「楕円」ならば

  '(1)シート上にあるすべての楕円を消す
  ActiveSheet.Ovals.Delete
  '(2)あたらしい楕円の描画
   ここにマクロで実行しているコードを書く

のように、図形を制限して実行すれば For〜Loopしなくて済みます。

以上、一般論でした。

【58645】Re:オートシェイプを消すマクロがわかり...
発言  かみちゃん  - 08/11/2(日) 15:07 -

引用なし
パスワード
   こんにちは。かみちゃん です。

ちょっと今時間がないので、簡単に。

>あと、Shapesコレクションにはオートシェイプ以外にも、
>グラフはもちろん、コメントや入力規則のドロップダウン▼や
>オートフィルタをかけていれば、そのドロップダウン▼も含まれます。

これ、失念してました。
数時間前に別の掲示板で、よく似た質問に対して、コメントしたところです。
こちらもフォローするのを忘れていました。

kanabunさんからの別案のアドバイスもあるので、そちらで検討していただいても
いいのですが、
一応、私が提示したコードの修正案を出しておきます。

Sub Sample1()
 Dim i As Integer

 For i = ActiveSheet.DrawingObjects.Count - 1 To 1 Step -1
  ActiveSheet.DrawingObjects(i).Delete
 Next
 MsgBox "最新のオブシェクト以外を削除しました" & vbCrLf & _
  "最新のオブジェクトは、" & ActiveSheet.DrawingObjects(1).Name
End Sub

ただし、このようにすると、フォームで配置したオブジェクトだけではなく、
コントロールツールバーで配置したオブジェクトも含まれるので、注意してください。

2回目の質問については、ちょっと、今、考えている余裕がありませんので、
時間ができ、コメントがついていなければ、検討します。
申し訳ありません。

【58646】Re:オートシェイプを消すマクロがわかり...
お礼  りー  - 08/11/2(日) 16:03 -

引用なし
パスワード
   ▼kanabun さん:
こんにちは。助言ありがとうございます。
kanabunさんの言う通り、他のオートシェイプが入ったシートで実行すると
すべて消えてしまいました。
このマクロを利用させてもらおうと思っていたものにも入力規則などを
使おうと思っていたので教えていただき大変助かりました。
ありがとうございました。

>描画して、最後に描画したオートシェイプ以外削除する のでなく、
>現在のシート上のオートシェイプを消しておいてから、
>目的のオートシェイプを描画すればいい、ような気がします。

おっしゃる通りです。
先に消しておけばよかったんですね。

>オプションボタンで描画しているのが、いつも「楕円」ならば
>
>  '(1)シート上にあるすべての楕円を消す
>  ActiveSheet.Ovals.Delete
>  '(2)あたらしい楕円の描画
>   ここにマクロで実行しているコードを書く
>
>のように、図形を制限して実行すれば For〜Loopしなくて済みます。

ありがとうございます。
この場合、他に「楕円」を使っていればそれも消えますよね?
それを避けるためにRangeオブジェクトなどを使って「楕円」を消す範囲を
指定することは可能でしょうか?
よろしければ教えてください。
よろしくお願いします。

【58647】Re:オートシェイプを消すマクロがわかり...
お礼  りー  - 08/11/2(日) 16:11 -

引用なし
パスワード
   こんにちは。

お時間が無い中、わざわざ回答いただきありがとうございました。
お2人の助言をもとに自分なりに少し試行錯誤してみたいと思います。

VBAを始めたばかりで分からない事だらけですので、今後もこの掲示板には
お世話になると思います。
その節はまたよろしくお願いします。

【58648】Re:オートシェイプを消すマクロがわかり...
発言  kanabun  - 08/11/2(日) 16:17 -

引用なし
パスワード
   ▼りー さん:

>この場合、他に「楕円」を使っていればそれも消えますよね?
>それを避けるためにRangeオブジェクトなどを使って「楕円」を消す範囲を
>指定することは可能でしょうか?

ヒントだけですが、
あるRange(セル範囲)を指定して、その範囲内の図形を列挙する命令は用意されてな
いので、図形(たとえば楕円)を Loop して、それがどのセル範囲にあるか
図の方から位置を求める形になります。

 Dim Oval As Excel.Oval
 For Each Oval In ActiveSheet.Ovals
   With Oval
     Debug.Print "["; .Name; "]", _
           .TopLeftCell.Address(0, 0), _
           .BottomRightCell.Address(0, 0)
   End With
 Next

【58649】Re:オートシェイプを消すマクロがわかり...
発言  かみちゃん  - 08/11/2(日) 17:05 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>この場合、他に「楕円」を使っていればそれも消えますよね?
>それを避けるためにRangeオブジェクトなどを使って「楕円」を消す範囲を
>指定することは可能でしょうか?

相変わらず時間がないのですが、他の掲示板で書いた内容を一部編集して、紹介します。

なお、指定したセル範囲の「楕円」のみを対象にするならば、kanabunさんのコードも加味されるといいと思います。
以下のコードは、指定された範囲のオブジェクトをすべて削除します。

Sub Sample3()
 Dim m As Long
 Dim i As Long
 Dim myShp As Shape
 Dim myR As Range, SR As Range

 On Error Resume Next
 Set myR = Application.InputBox("削除する範囲のセルをドラッグしてください", Type:=8)
 If Err.Number <> 0 Then Exit Sub
 On Error GoTo 0

' Set myR = ActiveSheet.Range("A1:A10")

 With ActiveSheet
  m = .DrawingObjects.Count
  For i = m To 1 Step -1
   With .DrawingObjects(i)
    Set SR = Range(.TopLeftCell, .BottomRightCell)
    If Not Intersect(SR, myR) Is Nothing Then
     If Intersect(SR, myR).Cells.Count = SR.Cells.Count Then
'      MsgBox .ShapeRange.Name & " を削除します"
      .Delete
     End If
    End If
    Set SR = Nothing
   End With
  Next i
 End With
 MsgBox "フォーム・コントーロルオブジェクトを削除しました"
End Sub


なお、以下のURLを参考にしています。
http://park11.wakwak.com/~miko/Excel_Note/17-03_zukei.htm#17-03-43

また、
 On Error Resume Next
 Set myR = Application.InputBox("削除する範囲のセルをドラッグしてください", Type:=8)
 If Err.Number <> 0 Then Exit Sub
 On Error GoTo 0
で任意のセル範囲を選択してから、処理するようにしていますが、
あらかじめ範囲を固定しておくということでいいのであれば、
 Set myR = ActiveSheet.Range("A1:A10")
だけでもいいと思います。

【58650】Re:オートシェイプを消すマクロがわかり...
お礼  りー  - 08/11/2(日) 18:29 -

引用なし
パスワード
   かみちゃんさん、kanabunさん大変ありがとうございました。
おかげさまで望み通りのマクロを完成させることができました。
お忙しい中、分かりにくい内容の質問に対して素早く的確な回答を
頂き本当に助かりました。

今後も質問させて頂くことがあると思いますのでその時には
またよろしくお願いします。

4053 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free