Доброй ночи,
У меня есть код, который позволяет мне удалить все изображения в столбце «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
Спасибо, k1dr0ck, теперь код работает быстрее с вашим предложением.
Если вы хотите попросить пользователя подтвердить, что он хочет запустить 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, огромное спасибо! Вы решаете мне проблему с кодом
просто дополнительное предложение: вы также можете удалить строки activewindow.scrollrow и просто использовать
Range("A2:A36").ClearContents