暗号化・復号化(3)

それではマクロ「暗号化・復号化」の中身をご覧下さい。

’------------------------------------------------------------

Sub 暗号化_復号化()
　  Dim KeyNum As Integer
    Dim StartRow As Long, StartCol As Long
    Dim EndRow As Long, EndCol As Long
    Dim X As Long, y As Long
    Dim Length As Long
    Dim Text
    Dim S As String, NewText As String
    Dim CodeNum As Long
    Dim i As Long
    Dim Ans As Integer
   
    Ans = MsgBox("選択範囲を暗号化→複合化　または　複合化→暗号化します。" & vbCrLf & "よろしいですか？　(＾o＾)b", vbYesNo)
    If Ans = vbNo Then Exit Sub
       
    StartRow = Selection.Row
    StartCol = Selection.Column
    EndRow = StartRow + Selection.Rows.Count - 1
    EndCol = StartCol + Selection.Columns.Count - 1
    Application.ScreenUpdating = False
    On Error Resume Next
    For X = StartCol To EndCol
        For y = StartRow To EndRow
            Text = Cells(y, X)
            If Range(Cells(y, X), Cells(y, X)).HasFormula Or Text = "" Then GoTo BEBE
            Length = Len(Text)
            
                NewText = ""
                For i = 1 To Length
                     S = Mid(Text, i, 1)
                     CodeNum = AscW(S)
                     CodeNum = CodeNum * -1
                     S = ChrW(CodeNum)
                     NewText = NewText & S
                Next
                Text = NewText
            
            Cells(y, X) = Text
BEBE:
        Next
    Next
    Application.ScreenUpdating = True
End Sub

'------------------------------------------------------------------------------------

赤字の行をご覧になればお分かりのように

取り出した文字コードに-1を乗じています。

従ってもう一度このマクロを実行すれば

暗号化された文字が復号化されます。

　みなさんが、この赤字の部分をお好きなように変更すれば

みなさん、独自の暗号キーになります。

★暗号化する場合の例

CodeNum = CodeNum + 123

★上記を復号化する場合の例

CodeNum = CodeNum - 123

　１２３を加えただけですから１２３を減じれば

元に戻るというわけです。

Comments

[投稿情報: かず]

なかなか面白いです。
-1をかけるって発想が良いですね！

ところで、For Each って重宝しますよ。

Dim MyRange As Range
For Each MyRange In Selection
Text = MyRange.Value
If MyRange.HasFormula Or Text = "" Then GoTo BEBE
…
Next

[投稿情報: くまぷー]

あ、かずさん、どもです。

For Eachループは知ってはいるのですが
あまり使いません、というか苦手です(^^ゞ

さて、かずさんご呈示のコードの省略され散る部分がわからないという方のために
一応、For Each ループコードの完全版を載せておきますね。

Sub 暗号化_復号化()

'かずさん改　For　Eachループを使用

Dim Length As Long
Dim Text
Dim S As String, NewText As String
Dim CodeNum As Long
Dim i As Long
Dim Ans As Integer
Dim MyRange As Range

Ans = MsgBox("選択範囲を暗号化→複合化　または　複合化→暗号化します。" & vbCrLf & "よろしいですか？　(＾o＾)b", vbYesNo)
If Ans = vbNo Then Exit Sub


Application.ScreenUpdating = False
On Error Resume Next

For Each MyRange In Selection

Text = MyRange.Value
If MyRange.HasFormula Or Text = "" Then GoTo BEBE
Length = Len(Text)

NewText = ""
For i = 1 To Length
S = Mid(Text, i, 1)
CodeNum = AscW(S)
CodeNum = CodeNum * -1
S = ChrW(CodeNum)
NewText = NewText & S
Next
Text = NewText

MyRange.Value = Text
BEBE:
Next

Application.ScreenUpdating = True
End Sub

[投稿情報: くまぷー]

・・・でExcel版のつぎはWordドキュメントの
暗号化を取り上げようと思っているのですが・・・

ホントに大雑把な仕様・・・

選択部分を暗号化・復号化するマクロ。(^^ゞ

[投稿情報: かず]

最近さっぱりマクロをさわってないので、
面白そうなので、他に、暗号化⇔復号化　の方法がないか考えてみました。
が、文字を逆に並べ替えるくらいしか思いつきませんでした。

Sub 暗号化_復号化2()
　Dim MyRange As Range
　Dim CellText As String
　Dim NewText As String
　Dim i As Long
　Dim Length As Long

　If TypeName(Selection) <> "Range" Then Exit Sub
　Application.ScreenUpdating = False
　For Each MyRange In Selection
　　CellText = MyRange.Value
　　If Not (MyRange.HasFormula Or CellText = "") Then
　　　Length = Len(CellText)
　　　NewText = ""
　　　For i = 1 To Length
　　　　NewText = ChrW(AscW(Mid(CellText, i, 1)) * -1) & NewText
　　　Next
　　　MyRange.Value = NewText
　　End If
　Next
　Application.ScreenUpdating = True
End Sub

[投稿情報: くまぷー]

お早うございます。

なるほど

NewText = ChrW(AscW(Mid(CellText, i, 1)) * -1) & NewText

右辺の第一項と第二項をひっくり返すことに
よって文字列を逆並びにする・・・
そうすれば解読するのにさらに一手間増える・・・
気がつきませんでした(^^ゞ
2人寄れば文殊の知恵？(^^ゞ