ndendrinos
10-22-2008, 04:57 AM
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, retVal, sKey As String
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Range("B30"), Target) Is Nothing Then
' Process Encryption.
sKey = Application.InputBox("Enter your key", "Key entry", "My Key", , , , , 2)
retVal = MsgBox("This is the key you entered:" & vbNewLine & Chr$(34) & sKey & Chr$(34) & vbNewLine & _
"Please confirm OK or Cancel to exit", vbOKCancel, "Confirm Key")
If retVal = vbCancel Then Exit Sub
For Each r In Sheets("Sheet1").UsedRange
If r.Interior.ColorIndex = 6 Then
r.Value = XorC(r.Value, sKey)
End If
Next r
End If
ws_exit:
Application.EnableEvents = True
Call Sendmail
Call Clearing
End Sub
Function XorC(ByVal sData As String, ByVal sKey As String) As String
Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte
Dim bEncOrDec As Boolean
'confirm valid string and key input:
If Len(sData) = 0 Or Len(sKey) = 0 Then XorC = "Invalid argument(s) used": Exit Function
'check whether running encryption or decryption (flagged by presence of "xxx" at start of sData):
If Left$(sData, 3) = "xxx" Then
bEncOrDec = False 'decryption
sData = Mid$(sData, 4)
Else
bEncOrDec = True 'encryption
End If
'assign strings to byte arrays (unicode)
byIn = sData
byOut = sData
byKey = sKey
l = LBound(byKey)
For i = LBound(byIn) To UBound(byIn) - 1 Step 2
byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - bEncOrDec 'avoid Chr$(0) by using bEncOrDec flag
l = l + 2
If l > UBound(byKey) Then l = LBound(byKey) 'ensure stay within bounds of Key
Next i
XorC = byOut
If bEncOrDec Then XorC = "xxx" & XorC 'add "xxx" onto encrypted text
End Function
Hello to all,
Above code is excellent and requires an expert to tailor it to my needs.... if possible please help.
The WB that contains this code (order form) will be sent to me by my customers.
What I hope for is to get rid of the box that requires the user to enter a "key" and the confirmation of it.
I want to be able to hard code a key of my choosing in the code ....let us say "max"
Thank you
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, retVal, sKey As String
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Range("B30"), Target) Is Nothing Then
' Process Encryption.
sKey = Application.InputBox("Enter your key", "Key entry", "My Key", , , , , 2)
retVal = MsgBox("This is the key you entered:" & vbNewLine & Chr$(34) & sKey & Chr$(34) & vbNewLine & _
"Please confirm OK or Cancel to exit", vbOKCancel, "Confirm Key")
If retVal = vbCancel Then Exit Sub
For Each r In Sheets("Sheet1").UsedRange
If r.Interior.ColorIndex = 6 Then
r.Value = XorC(r.Value, sKey)
End If
Next r
End If
ws_exit:
Application.EnableEvents = True
Call Sendmail
Call Clearing
End Sub
Function XorC(ByVal sData As String, ByVal sKey As String) As String
Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte
Dim bEncOrDec As Boolean
'confirm valid string and key input:
If Len(sData) = 0 Or Len(sKey) = 0 Then XorC = "Invalid argument(s) used": Exit Function
'check whether running encryption or decryption (flagged by presence of "xxx" at start of sData):
If Left$(sData, 3) = "xxx" Then
bEncOrDec = False 'decryption
sData = Mid$(sData, 4)
Else
bEncOrDec = True 'encryption
End If
'assign strings to byte arrays (unicode)
byIn = sData
byOut = sData
byKey = sKey
l = LBound(byKey)
For i = LBound(byIn) To UBound(byIn) - 1 Step 2
byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - bEncOrDec 'avoid Chr$(0) by using bEncOrDec flag
l = l + 2
If l > UBound(byKey) Then l = LBound(byKey) 'ensure stay within bounds of Key
Next i
XorC = byOut
If bEncOrDec Then XorC = "xxx" & XorC 'add "xxx" onto encrypted text
End Function
Hello to all,
Above code is excellent and requires an expert to tailor it to my needs.... if possible please help.
The WB that contains this code (order form) will be sent to me by my customers.
What I hope for is to get rid of the box that requires the user to enter a "key" and the confirmation of it.
I want to be able to hard code a key of my choosing in the code ....let us say "max"
Thank you