|
これで精一杯。
Sub ababa()
Dim Cbr As CommandBar, CLb As CommandBarControl
Dim CBB As CommandBarButton, ooo As Shape
On Error Resume Next
Application.CommandBars("図形の削除").Delete
Set Cbr = Application.CommandBars.Add(Name:="図形の削除")
Set CLb = Cbr.Controls.Add(msoControlEdit)
Cbr.Controls(1).Text = "このオブジェクトを削除しますか?"
Cbr.Controls(1).Width = 200
Set CBB = Cbr.Controls.Add(msoControlButton)
CBB.Style = msoButtonCaption
CBB.Caption = "OK"
CBB.OnAction = "'実行マクロ(1)'"
Set CBB = Nothing
Set CBB = Cbr.Controls.Add(msoControlButton)
CBB.Style = msoButtonCaption
CBB.Caption = "NO"
CBB.OnAction = "'実行マクロ(2)'"
Set CBB = Nothing
Cbr.Protection = msoBarNoChangeVisible
Cbr.Visible = True
For Each ooo In ActiveSheet.Shapes
ooo.TopLeftCell.Select 'オブジェクトを画面内に表示するため
'ooo.Select
Flg = False
Do Until Flg = True
If ooo.Visible = msoTrue Then
ooo.Visible = False
Else
ooo.Visible = True
End If
ActiveCell.Select
DoEvents
'Application.Wait Now + TimeValue("00:00:01")
Sleep 100
Loop
ooo.Visible = True
'↑ 図形を削除した場合はエラーになるから適当に修正してください。
Next
Application.CommandBars("図形の削除").Delete
End Sub
'この辺も適当に修正してください。
Sub 実行マクロ(No As Variant)
If No = 1 Then
MsgBox "削除"
ElseIf No = 2 Then
MsgBox "保留"
End If
Flg = True
End Sub
Sub dmdfk()
Application.CommandBars("図形の削除").Delete
End Sub
|
|