Время выполнения Ошибка 424 требуется объект - макрос шифрования с открытым ключом - PullRequest
0 голосов
/ 09 июля 2019

В настоящее время мы пытаемся заставить макрос шифрования работать с несколькими ячейками по всей книге, я много работаю с некоторыми из этих ячеек, поэтому я готов ко всему, чтобы улучшить этот поток.В настоящее время макрос находится под нашей кнопкой завершения формы.Это кодирование на листе 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.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...