Belajar Untuk Hidup, Hidup Untuk Belajar: VBA Excel : Convert Text To Colors

Masih bermain-main dengan properti Cells.Interior.Color...
Terinspirasi dari QR Code, sebuah kotak kecil berisi pola-pola titik yang bisa menampung informasi cukup besar jika dibandingkan dengan barcode. Namun disini saya tidak akan membahas QR lebih lanjut karena proyek yang saya buat jauh dari algoritma QR.

Proyek ini saya sebut dengan Text2Color (baca: Text to Color) karena berfungsi untuk mengubah sebuah teks menjadi kumpulan warna-warna dimana setiap warna mewakili satu karakter/huruf dan sebaliknya, jadi cocok untuk menulis pesan rahasia :D

Untuk lebih mempersingkat pembahasan (padahal lagi males menyusun kata-kata :D) langsung saja menuju ke kode :

Kode pada Userform

Private Sub CommandButton1_Click()
Dim kolom, baris, nChar, lnTxt, lnCol As Long

Cells.ColumnWidth = 0.42
Cells.RowHeight = 3.75
Cells.Clear
TextBox2.Text = ""

lnTxt = Len(TextBox1.Text)
lnCol = TextBox3.Text
baris = 1
Cells(1, 1).Value = lnTxt
Cells(1, 2).Value = lnCol

For nChar = 1 To lnTxt
kolom = kolom + 1
Cells(baris, kolom).Interior.color = char_to_color(Mid(TextBox1.Text, nChar, 1))
Application.StatusBar = "Processing | " & Round(((nChar / lnTxt) * 100), 0) & "%" 'Mid(TextBox1.Text, nChar, 5)
UserForm1.Caption = "Processing | " & Round(((nChar / lnTxt) * 100), 0) & "%" 'Mid(TextBox1.Text, nChar, 5)
If kolom = lnCol Then
    kolom = 0
    baris = baris + 1
End If

Next

Application.StatusBar = "Finished"
UserForm1.Caption = "Text2Color"
End Sub

Private Sub CommandButton2_Click()
Dim kolomX, barisX, nCharX, lnTxtX, lnColX As Long
Dim buffer As String

lnTxtX = Cells(1, 1).Value
lnColX = Cells(1, 2).Value
barisX = 1

For nCharX = 1 To lnTxtX
kolomX = kolomX + 1
buffer = buffer & color_to_char(Cells(barisX, kolomX).Interior.color)

If kolomX = lnColX Then
    kolomX = 0
    barisX = barisX + 1
End If

Next

TextBox2.Text = buffer
End Sub

Private Sub CommandButton3_Click()
End

End Sub

Private Sub CommandButton4_Click()
Dim pesan As String
pesan = "Text2Color 2009 by XANTOV" & vbCrLf & "email: xantov@gmail.com" & _
vbCrLf & vbCrLf & "Text2Color adalah aplikasi VBA yang dibuat untuk mengubah Tekst menjadi warna-warna yang tidak terbaca sebagai teks sehingga dapat digunakan untuk meng-enkrip suatu data text."
MsgBox pesan, vbInformation, "ext2Color 2009"

End Sub

Private Sub Label3_Click()

End Sub

Private Sub TextBox3_Change()
If TextBox3.Value > 500 Or TextBox1.Value <= 0 Then
TextBox3.Text = 100
End If

End Sub

Kode pada Modul

Function char_to_color(char As String) As Long
char_to_color = (Asc(char) ^ 3) * 5

End Function

Function color_to_char(colorx As Long) As String
color_to_char = Chr((colorx / 5) ^ (1 / 3))

End Function

Screenshoot