Option Explicit
 
Public Function encrypt(ByVal astring As String)
Dim zeichen, ausgabe, strlocal As String
Dim i, zahl, laenge, locallaenge As Integer
laenge = Int(Len(astring))
i = 1
Do While i <= laenge
'jedes Zeichen einzeln auswählen
zeichen = Right(Left(astring, i), 1)
'Char Code bestimmen
zahl = Asc(zeichen)
'Die Codezahl verändern
zahl = zahl * 3 - 200 'weitere Veränderungen möglich
'Zahl zu string konvertieren
strlocal = CStr(zahl)
'Länge des Strings ermitteln
locallaenge = Len(strlocal)
'wenn mehr als 9 stellen, Fehlermeldung
If locallaenge > 9 Then
MsgBox "Fehler beim Verschlüsseln", vbCritical Or vbOKOnly, "Fehler"
encrypt = ""
Exit Function
End If
'String zusammenstellen
strlocal = locallaenge & strlocal
'localen String in Ausgabevariabel speichern
ausgabe = ausgabe & strlocal
'inkremention von i für die schleife (immer ein zeichen weiter)
i = i + 1
Loop
'der Funktion den Ausgabestring zuweisen
encrypt = ausgabe
End Function
 
Public Function decrypt(ByVal astring As String)
Dim ausgabe, strlocal As String
Dim zahl, anzahl As Integer
'prüfen ob String eine zahl ist
If IsNumeric(astring) = False Then
MsgBox "Fehler beim Entschlüsseln!", vbCritical Or vbOKOnly, "Fehler"
decrypt = ""
Exit Function
End If
'Schleife solange bis astring leer ist
Do While astring <> ""
'die Anzahl der Zeichen ermitteln, die erfasst werden sollen
anzahl = Int(Left(astring, 1))
'die Zahl herausfinden die nach dem "Anzahl Zeichen" steht
'Bsp: Anzahl = 3, dann werden die nächsten 3 Zeichen ausgelesen
zahl = (Int(Right(Left(astring, 1 + anzahl), anzahl)) + 200) / 3
'Anhand von der errechneten Zahl den Charcode in einen String speichern
strlocal = Chr(zahl)
'locales Zeichen zu der Ausgabe dazugeben
ausgabe = ausgabe & strlocal
'Hauptstring (mit dem gerechnet wird) um den bearbeiteten Teil löschen
astring = Right(astring, Len(astring) - anzahl - 1)
Loop
'Der Funktion wird der Wert des Ausgabestrings zugewiesen
decrypt = ausgabe
End Function

Gehe immer vom Guten Willen Anderer aus!