Public Function ConvertToSecureString(Plaintext)

    'Stand: 26.08.2020
	'Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f

    Const offset = 10
    Const minAsc = 33
    Const maxAsc = 126

    Dim Ciphertext
    Randomize
    Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
    Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
    For i=1 To Len(Plaintext)*2
        If i mod 2 = 0 Then
            newAsc = Asc(Mid(Plaintext,i/2,1)) - offset
            If newAsc < minAsc Then
                newAsc = newAsc + maxAsc - minAsc + 1
            End If
            Ciphertext = Ciphertext & Chr(newAsc)
        '    MsgBox Asc(Mid(Plaintext,i/2,1)) & " -> " & newAsc
        Else
            Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
        '    MsgBox "Rnd:" & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
        End If
    Next
    Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
    Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
    ConvertToSecureString = Ciphertext

End Function

Private Sub EncryptTool()

    Plaintext = InputBox("Bitte den zu verschluesselnden String eingeben:","Eingabe erfolderlich","")
    Ciphertext = ConvertToSecureString(Plaintext)
    InputBox "Ihre Eingabe lautete: " & Plaintext & vbNewLine & vbNewLine & "Verschluesselt, sieht der String wie folgt aus:","Erledigt!",Ciphertext

End Sub

Call EncryptTool