В настоящее время мы пытаемся заставить макрос шифрования работать с несколькими ячейками по всей книге, я много работаю с некоторыми из этих ячеек, поэтому я готов ко всему, чтобы улучшить этот поток.В настоящее время макрос находится под нашей кнопкой завершения формы.Это кодирование на листе 1, код функции находится под «этой рабочей книгой»
Когда мы пытаемся запустить его под другим кодом worksheet_selectionchange (ByVal target As Range), текстовое поле не разрешается (got_focus)код для запуска на ячейке.Я попытался изменить местоположение кода, будь то в его собственной подпрограмме или вызывается с помощью кнопки, и я не могу заставить это исправить себя.ячейка, находящаяся в диапазоне, объединяется и будет («B23: D23»), но внесение этого изменения не изменило мою ошибку отладки.
Private Sub FINALIZEBTN_Click()
Dim response As VbMsgBoxResult
response = MsgBox("Have you completed the form in full?", vbYesNo)
If response = vbYes Then
MsgBox "Do not forget to save and submit this form"
ElseIf response = vbNo Then
MsgBox "Please review and complete the form in full"
Exit Sub
End If
Dim searchRange As Excel.Range
Dim cell As Variant
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = "[^ :@a-zA-Z0-9&\-]+"
.Global = True
.MultiLine = True
End With
Set searchRange = ActiveSheet.Range("B18:E52") '// Change as required
For Each cell In searchRange.Cells
If RegEx.Test(cell) Then cell.value = RegEx.Replace(cell.value, "")
cell.value = UCase(cell.value)
Next cell
Set searchRange = Nothing
Set RegEx = Nothing
'ENCRYPTION MACRO
Dim KeyCells As Range
Set KeyCells = Range("B23")
Dim publicKey As String
publicKey = "<RSAKeyValue><Modulus>r2+QhdQrh+jlSz/F2f9TyfVbar79NUHqiQby7paaUB5pejiYg/aI8on642s0FYNiiASSqK81+ORA9BXS0AHMnnkyplWZ7B2/KnrmFb3Ujoemzb794MpmUxtztrAocmIepJwsuShBQD2eUvCzNKI8aLcgH9mDGuG/HvagHCyzbyfV+yPtMGIHY2W1qboFGGvisAgVGjUgUAzpsqbuHiP1muohr5yKRmeyTwZmjEeWY/OuoX5zyDvjd0jsCw8GiNzkPqb6qCZR8KXSZNcyZnf4NbjR/dOD5qeEwFZWY32LmGFQW4GVOUfaIStvRwXq1G7k5oPXb6ccAhDtlrieM9l65p0X9alGYfTvLel4SBRRMqc8icadJq4KXTh1qRwp7w6uJUnd90GqfMXo1Qqyjwuqre0BBro/e3/BH8BorWynby3JAD5GNnBrB/RX9y/DFobNHXV9vtNhMTBMhCfSMhJQNlnH8nT3jcdvydbWEpNuJt3EKoCiOQlRXyv+bBL2sVTSzdCV4cWj7CfX5ZVCaliBu4nybqWOszZyQJqCHZCgnPj2Pww7wHkFUHqngiKdK6T45IkcdohLS8AU+zCUD9K6R6qTBG1S8JKkmEfuBhNx+uWMU0fwEL6ThhUmUAqZAm7MBKxnBkR+yoT5zsHoi3aYYi9sF7Opw+acqtY9zqi/OA0=</Modulus><Exponent>AQAB</Exponent></RSAKeyValue>" 'put entire xml string here
If Not Application.Intersect(KeyCells, Range(target.Address)) Is Nothing Then
Application.EnableEvents = False
If VarType(Range(target.Address).value) <> 8204 Then
If Len(Range(target.Address).value) < 256 Then 'making sure that encry sting isnt previously encrypted
Range(target.Address).value = ThisWorkbook.Encrypt(publicKey, CStr(Range(target.Address).value))
Range(target.Address).HorizontalAlignment = -4108 'XLALIGNCENTER
End If
Else
Range(target.Address).HorizontalAlignment = -4131 'XLALIGNLEFT
End If
Application.EnableEvents = True
End If
End Sub
Строка
If Not Application.Intersect(KeyCells, Range(target.Address)) Is Nothing Then
вызывает всплывающее окно с требованием ошибки 424.