Код для запроса подтверждения перед удалением изображений

Доброй ночи,

У меня есть код, который позволяет мне удалить все изображения в столбце «A1: A40». Я хотел бы добавить еще один код, чтобы запрашивалось подтверждение перед удалением фотографий. Идея заключалась в том, чтобы ошибка на кнопке не приводила к немедленному удалению всех фотографий в этой колонке. Именно такая ситуация у меня на данный момент и которую я хотел бы улучшить в файле. Я оставил 2 кода, которые работают, но я не знаю, как совместить один с другим.

Я уже пытался вставить второй код в первый, но я должен помещать его в неправильное место кода, потому что, когда появляется текстовое поле, нажав кнопку «Да» или «Нет», код всегда удаляет все фото. Может кто-нибудь помочь мне?

Первый код:

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

Эта последняя часть кода (ActiveWindows.ScrollRow = A2:A36) немного больше, потому что я записал макрос для этой части кода.

Второй код, который я хочу вставить в первый:

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

просто дополнительное предложение: вы также можете удалить строки activewindow.scrollrow и просто использовать Range("A2:A36").ClearContents

k1dr0ck 09.12.2022 03:46

Спасибо, k1dr0ck, теперь код работает быстрее с вашим предложением.

Luis Lopes 12.12.2022 19:39
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
0
2
50
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Если вы хотите попросить пользователя подтвердить, что он хочет запустить DeletePic, вам нужно добавить второй блок кода вверху DeletePic (в любом месте перед циклом For Each)

Ваш второй блок кода в настоящее время ничего не делает с результатом. Вы можете упростить его до чего-то вроде следующего:

Dim Result As VbMsgBoxResult
' ask if they want to continue
Result = MsgBox("Delete Pictures?", vbYesNo, "Confirm")
' if they do not, then exit out otherwise continue
If Result = vbNo Then Exit Sub

NickSlash, огромное спасибо! Вы решаете мне проблему с кодом

Luis Lopes 09.12.2022 08:30

Другие вопросы по теме