如何为删除A1:A40列图片的VBA代码添加确认弹窗

问题说明 #

我编写了名为DeletePic的VBA宏，功能是删除A1:A40区域内的所有图片，同时滚动到指定行并清空A2:A36的内容。为防止误触按钮导致误删，想要添加确认弹窗，但合并两段独立运行的代码后，无论点击弹窗的“是”或“否”，图片都会被删除，需要正确的代码合并方法。

两段原始代码：

原始删除宏代码 #

Sub DeletePic()
    Dim xPicRg As Range
    Dim xPic As Picture
    Dim xRg As Range
    Application.ScreenUpdating = False
    Set xRg = Range("A1:A40")
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete      
        
    Next
    Application.ScreenUpdating = True
    
    Range("A2:A36").Select
    ActiveWindow.ScrollRow = 33
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Selection.ClearContents
End Sub

原始弹窗代码 #

Dim Msg, Style, Title, Response, MyString
Msg = "Deseja continuar ?" 
Style = vbYesNo 
Title = "Esta operação apagará todas as fotografias"  
        
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then   
    MyString = "Yes"  
Else    
    MyString = "No" 
End If

正确合并后的代码 #

Sub DeletePic()
    Dim Msg, Style, Title, Response
    Dim xPicRg As Range
    Dim xPic As Picture
    Dim xRg As Range
    
    ' 弹出确认对话框（已翻译为中文）
    Msg = "是否继续？" 
    Style = vbYesNo 
    Title = "此操作将删除所有图片"  
    Response = MsgBox(Msg, Style, Title)
    
    ' 用户点击“否”则直接退出宏，不执行后续操作
    If Response <> vbYes Then Exit Sub
    
    Application.ScreenUpdating = False
    Set xRg = Range("A1:A40")
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete      
    Next
    Application.ScreenUpdating = True
    
    ' 简化滚动与清空操作，去掉冗余代码
    Range("A2:A36").ClearContents
    ActiveWindow.ScrollRow = 1
End Sub

关键修改说明 #

• 弹窗逻辑前置：将确认弹窗放在宏的最开头，先获取用户选择，再决定是否执行核心操作
• 条件控制流程：通过If Response <> vbYes Then Exit Sub判断，用户点击“否”时直接终止宏，避免误执行删除
• 优化冗余代码：把重复的滚动行语句简化为直接设置ActiveWindow.ScrollRow = 1，同时去掉不必要的Select操作，直接调用ClearContents更高效

内容的提问来源于stack exchange，提问作者Luis Lopes