| |
>結合、結合の解除
とは、グループ化と解除の意味でしょーか ?
一応そうであるとして、まずシート上にフォームツールバーのボタンを
３個配置し、その全てに以下のマクロを登録して下さい。
次に数式バーを出して [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ですが、こちらでテストした限りはうまくいきました。
|
|
Kein
- 07/6/21(木) 16:07 -
