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
    评论
Excel VBA中实现批量提取Word表格内容可以通过以下步骤进行: 1.首先,在Excel的工作簿中打开Visual Basic Editor(VBE)。 2.在VBE的工具栏上,选择“插入”→“模块”,在模块中编写VBA代码。 3.在编写代码之前,确保已经添加对Microsoft Word对象库的引用。可以通过在VBE中选择“工具”→“引用”来添加引用。 4.在VBA代码的模块中,使用Word对象变量来打开Word文档。例如,可以使用以下代码打开一个名为"Document1.docx"的Word文档: ``` Dim wdApp As Word.Application Dim wdDoc As Word.Document Set wdApp = New Word.Application Set wdDoc = wdApp.Documents.Open("C:\路径\Document1.docx") wdApp.Visible = True ``` 5.接下来,使用“With”语句和对象变量来引用Word文档中的表格,然后遍历表格中的每个单元格,并将其值复制到Excel工作表中。 ``` With wdDoc For Each tbl In .Tables For Each cell In tbl.Range.Cells '将单元格值复制到Excel工作表中的指定位置 Worksheets("Sheet1").Cells(rowNum, colNum).Value = cell.Range.Text '更新行号和列号 rowNum = rowNum + 1 colNum = colNum + 1 Next cell Next tbl End With ``` 6.在代码结束时,记得关闭Word文档和应用程序对象。 ``` wdDoc.Close wdApp.Quit Set wdDoc = Nothing Set wdApp = Nothing ``` 以上步骤将通过Excel VBA实现一键批量提取Word表格内容。可以根据具体需求进行适当的修改和调整,如指定目标表格的位置、添加错误处理等。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值