Microsoft VBA Excel 一键删除全部sheet

问题场景

简述:

设计一个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
  • 7
    点赞
  • 8
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值