pegando cada letra de uma text

Caro Maxxwel como prometi criei o código que faz a criptação e descriptação como você me pediu, torno novamente a dizer que existem outros código que são bem mais simples que este, porém, este servirá para estudo vamos a explicação:

Primeiro peguei o código anterior e criei uma função dele, dei o nome a função de CRIPTA, em seguida criei uma outra função com o nome DESCRIPTA, eis a forma que fiz os códigos:

coloque estas duas funções dentro de um módulo:

Function Cripta(Texto As String) As String

' Cripta retornará uma string a partir da string texto
Dim chave As Variant
Dim a, b, c, d, e, f As Variant
Dim g, h, i, j, k, l As Variant
Dim m, n, o, p, q, r As Variant
Dim s, t, u, v, x, w As Variant
Dim y, z, Espaco As Variant

' aqui criei mais um array com o nome espaco

a = Array("01", "02", "03", "04")
b = Array("11", "12", "13", "14")
c = Array("21", "22", "23", "24")
d = Array("31", "32", "33", "34")
e = Array("41", "42", "43", "44")
f = Array("51", "52", "53", "54")
g = Array("61", "62", "63", "64")
h = Array("71", "72", "73", "74")
i = Array("81", "82", "83", "84")
j = Array("91", "92", "93", "94")
k = Array("05", "06", "07", "08")
l = Array("15", "16", "17", "18")
m = Array("25", "26", "27", "28")
n = Array("35", "36", "37", "38")
o = Array("45", "46", "47", "48")
p = Array("55", "56", "57", "58")
q = Array("65", "66", "67", "68")
r = Array("75", "76", "77", "78")
s = Array("85", "86", "87", "88")
t = Array("95", "96", "97", "98")
u = Array("10", "20", "30", "40")
v = Array("50", "60", "70", "80")
w = Array("90", "00", "A0", "B0")
x = Array("C0", "D0", "E0", "F0")
y = Array("G0", "H0", "I0", "J0")
z = Array("K0", "L0", "M0", "N0")
Espaco = Array("SP", "8F", "H2", "0L")

For busca = 0 To Len(Texto)

' neste caso a chave será aleatória
chave = Int(3 * Rnd)

' select case converte todas as letras para maiusculas "Ucase"

' e verifica letra por letra junto com o laço for BUSCA
Select Case UCase(Mid(Texto, busca + 1, 1))

' então se a letra do SELECT for a letra "a" ...

Case "a"

' inicia-se a montagem da string Cripta com a chave aleatória, e assim por diante.
Cripta = Cripta + a(chave)
Case "b"
Cripta = Cripta + b(chave)
Case "c"
Cripta = Cripta + c(chave)
Case "d"
Cripta = Cripta + d(chave)
Case "e"
Cripta = Cripta + e(chave)
Case "f"
Cripta = Cripta + f(chave)
Case "g"
Cripta = Cripta + g(chave)
Case "h"
Cripta = Cripta + h(chave)
Case "i"
Cripta = Cripta + i(chave)
Case "j"
Cripta = Cripta + j(chave)
Case "k"
Cripta = Cripta + k(chave)
Case "l"
Cripta = Cripta + l(chave)
Case "m"
Cripta = Cripta + m(chave)
Case "n"
Cripta = Cripta + n(chave)
Case "o"
Cripta = Cripta + o(chave)
Case "p"
Cripta = Cripta + p(chave)
Case "q"
Cripta = Cripta + q(chave)
Case "r"
Cripta = Cripta + r(chave)
Case "s"
Cripta = Cripta + s(chave)
Case "t"
Cripta = Cripta + t(chave)
Case "u"
Cripta = Cripta + u(chave)
Case "v"
Cripta = Cripta + v(chave)
Case "w"
Cripta = Cripta + w(chave)
Case "x"
Cripta = Cripta + x(chave)
Case "y"
Cripta = Cripta + y(chave)
Case "z"
Cripta = Cripta + z(chave)
Case " "
Cripta = Cripta + Espaco(chave)
End Select
Next busca
End Function

' A seguir a função para inverter o processo anterior só que desta vez

' a nomeie de Descripta

Function Descripta(Texto As String) As String
Dim chave As String
Dim a, b, c, d, e, f As Variant
Dim g, h, i, j, k, l As Variant
Dim m, n, o, p, q, r As Variant
Dim s, t, u, v, x, w As Variant
Dim y, z, Espaco As Variant

' a diferença deste laço para o anterior é que ele será feito

' de dois em dois por isso o Step 2

' pois é a forma que se e criptado cada letra, ou seja z=KO
For busca = 0 To Len(Texto) Step 2

' este segundo laço "LETRA" fará averificação dentro de cada array, ou seja

' cada array possui quatro campos começando do zero
For letra = 0 To 3

' chave neste caso é uma string que irá armazenar as duas letras selecionadas...

chave = UCase(Mid(Texto, busca + 1, 2))

' e fará a comparação com as arrays EX: se 01 estiver dentro da array "a" então...

If chave = a(letra) Then

' será montada a string "Descripta" com o caractere "A", e assim por diante.
Descripta = Descripta + "A"
ElseIf chave = b(letra) Then
Descripta = Descripta + "B"
ElseIf chave = c(letra) Then
Descripta = Descripta + "C"
ElseIf chave = d(letra) Then
Descripta = Descripta + "D"
ElseIf chave = e(letra) Then
Descripta = Descripta + "E"
ElseIf chave = f(letra) Then
Descripta = Descripta + "F"
ElseIf chave = g(letra) Then
Descripta = Descripta + "G"
ElseIf chave = h(letra) Then
Descripta = Descripta + "H"
ElseIf chave = i(letra) Then
Descripta = Descripta + "I"
ElseIf chave = j(letra) Then
Descripta = Descripta + "J"
ElseIf chave = k(letra) Then
Descripta = Descripta + "K"
ElseIf chave = l(letra) Then
Descripta = Descripta + "L"
ElseIf chave = m(letra) Then
Descripta = Descripta + "M"
ElseIf chave = n(letra) Then
Descripta = Descripta + "N"
ElseIf chave = o(letra) Then
Descripta = Descripta + "O"
ElseIf chave = p(letra) Then
Descripta = Descripta + "P"
ElseIf chave = q(letra) Then
Descripta = Descripta + "Q"
ElseIf chave = r(letra) Then
Descripta = Descripta + "R"
ElseIf chave = s(letra) Then
Descripta = Descripta + "S"
ElseIf chave = t(letra) Then
Descripta = Descripta + "T"
ElseIf chave = u(letra) Then
Descripta = Descripta + "U"
ElseIf chave = v(letra) Then
Descripta = Descripta + "V"
ElseIf chave = w(letra) Then
Descripta = Descripta + "W"
ElseIf chave = x(letra) Then
Descripta = Descripta + "X"
ElseIf chave = y(letra) Then
Descripta = Descripta + "Y"
ElseIf chave = z(letra) Then
Descripta = Descripta + "Z"
ElseIf chave = Espaco(letra) Then
Descripta = Descripta + " "
End If
Next letra
Next busca
End Function

Pronto feito isso no módulo bata você chamar a função no form desta forma

primeiro insira no seu form para teste: 01 textbox, 02 Labels e 02 Commando buttons

agora cole este código, e veja se funciona para você

Private Sub Command1_Click()
Label1.Caption = Cripta(Text1.Text)
End Sub

Private Sub Command2_Click()
Label2.Caption = Descripta(Label1.Caption)
End Sub

acho que era isto que você queira, precisando de algo mais estarei por aqui um abraço.

Marcelo Treze