问题场景
简述:
设计一个VBA按钮,一键删除本文档除指定sheet以外的全部sheet,但是在按下后需要确定出现两次确定删除所有sheet的弹窗避免误触。
代码描述
Sub DeleteAllSheets()
Dim ws As Worksheet
Dim iResponse As Integer
' 第一次确认
iResponse = MsgBox("您确定要删除所有工作表吗?", vbYesNo + vbExclamation, "第一次确认")
If iResponse <> vbYes Then Exit Sub
' 第二次确认
iResponse = MsgBox("最后确认:您真的确定要删除所有工作表吗?", vbYesNo + vbCritical, "最后确认")
If iResponse <> vbYes Then Exit Sub
' 删除所有工作表,但保留一个(因为Excel至少需要一个工作表)
Application.DisplayAlerts = False ' 关闭Excel警告
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True ' 开启Excel警告
' 检查是否存在名为'Summary'的工作表,如果不存在,通知用户
On Error Resume Next ' 如果工作表不存在则忽略错误
If ThisWorkbook.Sheets("Summary") Is Nothing Then
MsgBox "未找到名为'汇总'的工作表。所有其他工作表已被删除。", vbInformation, "操作完成"
Else
MsgBox "除了'汇总'之外的所有工作表已被删除。", vbInformation, "操作完成"
End If
On Error GoTo 0 ' 重置错误处理
End Sub
英文版:
Sub DeleteAllSheets()
Dim ws As Worksheet
Dim iResponse As Integer
' First confirmation
iResponse = MsgBox("Are you sure you want to delete all sheets except 'Summary'?", vbYesNo + vbExclamation, "First Confirmation")
If iResponse <> vbYes Then Exit Sub
' Second confirmation
iResponse = MsgBox("Final confirmation: Are you REALLY sure you want to delete all sheets except 'Summary'?", vbYesNo + vbCritical, "Final Confirmation")
If iResponse <> vbYes Then Exit Sub
Application.DisplayAlerts = False ' Turn off Excel warnings
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True ' Turn Excel warnings back on
' Check if the Summary sheet exists, if not, inform the user
On Error Resume Next ' Ignore error if sheet doesn't exist
If ThisWorkbook.Sheets("Summary") Is Nothing Then
MsgBox "No 'Summary' sheet was found. All other sheets have been deleted.", vbInformation, "Operation Completed"
Else
MsgBox "All sheets except 'Summary' have been deleted.", vbInformation, "Operation Completed"
End If
On Error GoTo 0 ' Reset error handling
End Sub