Excel VBA質問箱 IV

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

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


5621 / 13645 ツリー ←次へ | 前へ→

【49768】セル範囲のオブジェクトを全て選択 初心者TT 07/6/21(木) 13:02 質問[未読]
【49769】Re:セル範囲のオブジェクトを全て選択 Kein 07/6/21(木) 13:21 発言[未読]
【49771】Re:セル範囲のオブジェクトを全て選択 初心者TT 07/6/21(木) 13:37 発言[未読]
【49778】Re:セル範囲のオブジェクトを全て選択 ハチ 07/6/21(木) 16:00 回答[未読]
【49780】Re:セル範囲のオブジェクトを全て選択 初心者TT 07/6/21(木) 16:14 お礼[未読]
【49779】Re:セル範囲のオブジェクトを全て選択 Kein 07/6/21(木) 16:07 回答[未読]
【49806】Re:セル範囲のオブジェクトを全て選択 初心者TT 07/6/22(金) 19:04 お礼[未読]
【49770】Re:セル範囲のオブジェクトを全て選択 マクロマン 07/6/21(木) 13:23 発言[未読]
【49772】Re:セル範囲のオブジェクトを全て選択 初心者TT 07/6/21(木) 13:39 発言[未読]

【49768】セル範囲のオブジェクトを全て選択
質問  初心者TT  - 07/6/21(木) 13:02 -

引用なし
パスワード
   セル範囲のオブジェクト(オートシェイプ)を全て選択する方法を教えていただきたいのですが、、

ちなみに某サイトから拝借して一部編集した下の記述ですと、最後のオブジェクトのみが選択されてしまうので、

おそらく順順に選択していって前のオブジェクトの選択は、選択するたびに解除していっていると思うのですが、すべての選択を残す方法があれば教えてください><

Private Sub 全て選択ボタン_Click()
Sub Sample()
Dim S As Shape
Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
x1 = Selection.Left
y1 = Selection.Top
x2 = x1 + Selection.Width
y2 = y1 + Selection.Height
For Each S In ActiveSheet.Shapes
If S.Left >= x1 And S.Top >= y1 And _
S.Left + S.Width <= x2 And S.Top + S.Height <= y2 Then
S.Select
End If
Next

End Sub

【49769】Re:セル範囲のオブジェクトを全て選択
発言  Kein  - 07/6/21(木) 13:21 -

引用なし
パスワード
   選択して何をしたいのでしょーか ?
通常、オブジェクトに何らかの操作をする場合、選択しなくても出来る
ことの方が多いですが。

【49770】Re:セル範囲のオブジェクトを全て選択
発言  マクロマン  - 07/6/21(木) 13:23 -

引用なし
パスワード
   選択した後どうするのでしょう?

【49771】Re:セル範囲のオブジェクトを全て選択
発言  初心者TT  - 07/6/21(木) 13:37 -

引用なし
パスワード
   ありがとうございます。

具体的には、選択ボタンでセル範囲のオブジェクトを選択し、

セル範囲で選択したあと更にシフトクリックで選択除外ができるようにして

選択したオブジェクトの削除、結合、結合の解除を各コマンドボタンで行いたいのですが、、

選択したオブジェクトの削除、結合、結合解除はVBAで可能でしたので

後はセル範囲で選択するマクロだけなのですが・・・

どなたかいい方法ご存知の方 ご教授お願いします。

【49772】Re:セル範囲のオブジェクトを全て選択
発言  初心者TT  - 07/6/21(木) 13:39 -

引用なし
パスワード
   マクロマン さんもありがとうございます。

もし何かいい方法がありましたらご教授ください><

【49778】Re:セル範囲のオブジェクトを全て選択
回答  ハチ  - 07/6/21(木) 16:00 -

引用なし
パスワード
   ▼初心者TT さん:

なんとなく作ってみたのでバグがあるかも・・・
対象のセルの範囲を選択した状態で実行してみてください。
全体が含まれることで対象となるなら、
If xx And xx で
範囲に少しでもかかっているオブジェクトが対象なら
If xx Or xx にしてみてください。

Option Explicit

Sub Shapes_Select()
  Dim Target As Range 'セルの選択範囲
  Dim objShe As Shape 'ループ用のShape
  
  If TypeName(Selection) <> "Range" Then
    MsgBox "セルの範囲を選択して実行してください"
    Exit Sub
  End If
  Set Target = Selection
  For Each objShe In ActiveSheet.Shapes
    With Application
      '全体が範囲内で対象ならAndで。少しでも範囲に入っているならOr
      If Not .Intersect(Target, objShe.TopLeftCell) Is Nothing And _
      Not .Intersect(Target, objShe.BottomRightCell) Is Nothing Then
        objShe.Select False
      End If
    End With
  Next
  Set Target = Nothing
  
End Sub

【49779】Re:セル範囲のオブジェクトを全て選択
回答  Kein  - 07/6/21(木) 16:07 -

引用なし
パスワード
   >結合、結合の解除
とは、グループ化と解除の意味でしょーか ?
一応そうであるとして、まずシート上にフォームツールバーのボタンを
3個配置し、その全てに以下のマクロを登録して下さい。
次に数式バーを出して [Ctrl]キー を押しながら各ボタンを選択し、いったん
[Ctrl]キーを離して Caption の "ボタン ?" を選択、アイコンが I の形
になったら Caption の編集が出来るので、順に「グループ化」「グループ解除」
「削除」と変更します。そのとき最初の Caption とは違う番号の "ボタン ?"
が数式バーの左端に表示されるはずですから、それをメモしておいて↓のマクロ
の"ボタン 48","ボタン 49","ボタン 50"を書き換えて下さい。

Sub MyDrw()
  Dim Drw As Object
  Dim i As Long
  Dim x1 As Single, y1 As Single
  Dim x2 As Single, y2 As Single
  Dim MyL As Single, MyT As Single
  Dim MyW As Single, MyH As Single
  Dim Cll As Variant
  Dim Ary() As String
 
  Cll = Application.Caller
  If VarType(Cll) <> 8 Then Exit Sub
  If TypeName(Selection) <> "Range" Then Exit Sub
  If Selection.Count = 1 Then Exit Sub
  If ActiveSheet.DrawingObjects.Count = 0 Then Exit Sub
  With Selection
   x1 = .Left: y1 = .Top
   x2 = x1 + .Width: y2 = y1 + .Height
  End With
  For Each Drw In ActiveSheet.DrawingObjects
   If TypeName(Drw) = "Button" Then GoTo NLine
   MyL = Drw.Left: MyT = Drw.Top
   MyW = MyL + Drw.Width: MyH = MyT + Drw.Height
   If MyL >= x1 And MyT >= y1 And _
   MyW <= x2 And MyH <= y2 Then
     Select Case Cll
      Case "ボタン 48"
        ReDim Preserve Ary(i): Ary(i) = Drw.Name
        i = i + 1
      Case "ボタン 49"
        If TypeName(Drw) = "GroupObject" Then Drw.Ungroup
      Case "ボタン 50"
        Drw.Delete
     End Select
   End If
NLine:
  Next
  If Cll = "ボタン 48" Then
   ActiveSheet.DrawingObjects(Ary).Group: Erase Ary
  End If
End Sub

作成はExcel2000ですが、こちらでテストした限りはうまくいきました。

【49780】Re:セル範囲のオブジェクトを全て選択
お礼  初心者TT  - 07/6/21(木) 16:14 -

引用なし
パスワード
   >>ハチ さん


ありがとうございます。

できました><

こんな方法もあるんですねー

精進します。

ありがとうございました!!

【49806】Re:セル範囲のオブジェクトを全て選択
お礼  初心者TT  - 07/6/22(金) 19:04 -

引用なし
パスワード
   >>Kein さん

お返事が送れてしまいすいませんでした。。

ハチさんから教えていただいた方法で全て選択ということができたので、

気づくのが遅れてしまいました。

ありがとうございます。

参考にさせていただきます!

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