Excel VBA質問箱 IV

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

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


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

【18820】図形の選択 ちょこちょこ 04/10/13(水) 15:48 質問[未読]
【18823】Re:図形の選択 Jaka 04/10/13(水) 16:27 発言[未読]
【18825】これかな? ぴかる 04/10/13(水) 17:19 発言[未読]
【18827】Re:これかな? ちょこちょこ 04/10/13(水) 18:54 お礼[未読]
【18835】Re:これかな? Jaka 04/10/14(木) 9:55 回答[未読]

【18820】図形の選択
質問  ちょこちょこ  - 04/10/13(水) 15:48 -

引用なし
パスワード
   まだVBAを始めて初心者のものです。
初歩的なことかもしれませんが是非ご指導お願いします。

図形を選択したいのですが、
例えば A1:E30の中の全ての図形を選択するとしたら
どのようにすればいいのでしょうか?

Activesheet.Shapes.Selectall

にするとシート全てのオブジェクトを選択してしまい、
必要の無いものまで全て選んでしまいます。

どのようにすれば範囲選択をすることが可能なのでしょうか

どうぞよろしくお願います。

【18823】Re:図形の選択
発言  Jaka  - 04/10/13(水) 16:27 -

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

これね、初歩どころか結構面倒くさいですよ。
全ての図形オブジェクトを調べるわけですから...。
種類判定して位置や大きさも考慮して、セル範囲にひっかっているか計算するわけだから....。

今や伝説となってしまった「りんさん」が、似たようなコード書いたんですがどうやってたか覚えていません。
りんさんの参考コードを探してみますが、残っているかどうか....。

【18825】これかな?
発言  ぴかる  - 04/10/13(水) 17:19 -

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

>今や伝説となってしまった「りんさん」が、似たようなコード書いたんですがどうやってたか覚えていません。
>りんさんの参考コードを探してみますが、残っているかどうか....。
多分、↓とちゃいますか?。ちとアレンジして、選択したセルの内容をクリアするマクロにしています。りんさ〜ん、みんな寂しがってますよ〜。たまには、遊びに来て下さいネ!。

Sub 全てクリア()
 
Dim Sh As Shape, r1 As Range, r2 As Range

  On Error GoTo errout
  If ActiveSheet.ProtectContents Then
  Else
   If TypeName(Selection) = "Range" Then
    Selection.Clear
    If TypeName(Selection) = "Range" Then
     If ActiveSheet.Shapes.Count > 0 Then
      For Each Sh In ActiveSheet.Shapes
       '図形が完全に範囲に含まれる場合は削除する
       '図形左上セルのチェック
       Set r1 = Application.Intersect(Selection, _
                      Sh.TopLeftCell)
       '図形右下セルのチェック
       Set r2 = Application.Intersect(Selection, _
                      Sh.BottomRightCell)
       If r1 Is Nothing Or r2 Is Nothing Then
       '左上セルまたは右下セルが選択範囲の外にある場合は無視
        '両方外にある場合も無視
       Else
        Sh.Delete
       End If
      Next
     End If
    End If
   Else
    Selection.Delete
   End If
  End If
  Set r1 = Nothing: Set r2 = Nothing

  Exit Sub
errout:

End Sub

【18827】Re:これかな?
お礼  ちょこちょこ  - 04/10/13(水) 18:54 -

引用なし
パスワード
   ありがとうございます。
早速やってみます。 すごく高度なことだったのですね。

本当にありがとうございました。

【18835】Re:これかな?
回答  Jaka  - 04/10/14(木) 9:55 -

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

おお〜、これこれ、と思いましたが、ちょっと違うような...。
これだと図形類が、セル範囲にすっぽり入ってないとダメですね。
ちょっとでもひっかっていたらってやつがあったと思うんですけど...。
確かりんさんはそんな風に言っていたような気がします。
試してみなかったんで、その辺はあいまいですが。

これでよかったら、こんな感じに配列にセットすれば良いです.

Sub 範囲選択()
 
Dim Sh As Shape, r1 As Range, r2 As Range
Dim ObjTb() As Variant, Ct As Integer
  'On Error GoTo errout

  If ActiveSheet.ProtectContents Then
  Else
   If TypeName(Selection) = "Range" Then
    'Selection.Clear
    If TypeName(Selection) = "Range" Then
     If ActiveSheet.Shapes.Count > 0 Then
      For Each Sh In ActiveSheet.Shapes
       '図形が完全に範囲に含まれる場合は削除する
       '図形左上セルのチェック
       Set r1 = Application.Intersect(Selection, _
                      Sh.TopLeftCell)
       '図形右下セルのチェック
       Set r2 = Application.Intersect(Selection, _
                      Sh.BottomRightCell)
       If r1 Is Nothing Or r2 Is Nothing Then
       '左上セルまたは右下セルが選択範囲の外にある場合は無視
        '両方外にある場合も無視
       Else
        Ct = Ct + 1
        ReDim Preserve ObjTb(1 To Ct)
        ObjTb(Ct) = Sh.Name
       End If
      Next
     End If
    End If
   Else
    'Selection.Delete
   End If
  End If
  On Error Resume Next
  If UBound(ObjTb) <> 0 Then
    ActiveSheet.Shapes.Range(ObjTb).Select
  End If
  Set r1 = Nothing: Set r2 = Nothing
  Erase ObjTb
  Exit Sub
errout:

End Sub

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