VBA for Excel : Membuat TTS Interaktif dengan Excel

Pada posting ini disajikan listing program untuk membuat TTS Interaktif dengan Excel.

Kotak TTS :

gbr1

Pertanyaan TTS :

gbr2

 

Listing Program agar TTS Excel anda menjadi Interaktif :

ttribute VB_Name = “Module1”
Sub reset()
‘KOSONGKAN CELL
Dim kotakClear As Variant

kotakClear = Array(Range(“B4:K4”), Range(“B6,E6,G6,I6,K6,L6”), Range(“B8:E8,G8:I8,K8”), _
Range(“B10,D10:G10,I10:L10”), Range(“B12,D12,F12,H12,J12,L12”), Range(“B14:E14,G14:J14,L14”), _
Range(“C16,E16:G16,I16:L16”), Range(“B18,C18,E18,G18,I18,L18”), Range(“C20:L20”))

For i = 0 To 8
With kotakClear(i)
.Value = “”
.Font.Color = RGB(0, 0, 0)
End With
Next

Worksheets(“TTSNo2”).Shapes(“Button 2”).Visible = True

End Sub
Sub periksa()

Dim kunci1 As Variant
Dim kunci2 As Variant
Dim kotak As Variant
Dim Jbenar As Integer
Dim nilaiTTS As Double

‘KUNCI JAWABAN DENGAN HURUF KAPITAL
kunci1 = Array(“P”, “O”, “L”, “I”, “K”, “L”, “I”, “N”, “I”, “K”, _
“A”, “R”, “A”, “U”, “U”, “U”, _
“T”, “A”, “L”, “I”, “K”, “A”, “R”, “D”, _
“U”, “A”, “T”, “A”, “U”, “I”, “K”, “A”, “N”, _
“N”, “I”, “S”, “R”, “A”, “O”, _
“G”, “U”, “N”, “A”, “S”, “I”, “A”, “L”, “N”, _
“F”, “M”, “A”, “U”, “S”, “A”, “I”, “S”, _
“M”, “U”, “A”, “A”, “I”, “E”, _
“K”, “A”, “L”, “I”, “M”, “A”, “N”, “T”, “A”, “N”)
‘KUNCI JAWABAN DENGAN HURUF KECIL
kunci2 = Array(“p”, “o”, “l”, “i”, “k”, “l”, “i”, “n”, “i”, “k”, _
“a”, “r”, “a”, “u”, “u”, “u”, _
“t”, “a”, “l”, “i”, “k”, “a”, “r”, “d”, _
“u”, “a”, “t”, “a”, “u”, “i”, “k”, “a”, “n”, _
“n”, “i”, “s”, “r”, “a”, “o”, _
“g”, “u”, “n”, “a”, “s”, “i”, “a”, “l”, “n”, _
“f”, “m”, “a”, “u”, “s”, “a”, “i”, “s”, _
“m”, “u”, “a”, “a”, “i”, “e”, _
“k”, “a”, “l”, “i”, “m”, “a”, “n”, “t”, “a”, “n”)
‘KOTAK YANG DIGUNAKAN UNTUK ISIAN TTS
kotak = Array(Range(“B4”), Range(“C4”), Range(“D4”), Range(“E4”), Range(“F4”), Range(“G4”), Range(“H4”), Range(“I4”), Range(“J4”), Range(“K4”), _
Range(“B6”), Range(“E6”), Range(“G6”), Range(“I6”), Range(“K6”), Range(“L6”), _
Range(“B8”), Range(“C8”), Range(“D8”), Range(“E8”), Range(“G8”), Range(“H8”), Range(“I8”), Range(“K8”), _
Range(“B10”), Range(“D10”), Range(“E10”), Range(“F10”), Range(“G10”), Range(“I10”), Range(“J10”), Range(“K10”), Range(“L10”), _
Range(“B12”), Range(“D12”), Range(“F12”), Range(“H12”), Range(“J12”), Range(“L12”), _
Range(“B14”), Range(“C14”), Range(“D14”), Range(“E14”), Range(“G14”), Range(“H14”), Range(“I14”), Range(“J14”), Range(“L14”), _
Range(“C16”), Range(“E16”), Range(“F16”), Range(“G16”), Range(“I16”), Range(“J16”), Range(“K16”), Range(“L16”), _
Range(“B18”), Range(“C18”), Range(“E18”), Range(“G18”), Range(“I18”), Range(“L18”), _
Range(“C20”), Range(“D20”), Range(“E20”), Range(“F20”), Range(“G20”), Range(“H20”), Range(“I20”), Range(“J20”), Range(“K20”), Range(“L20”))

‘PERIKSA JAWABAN DENGAN KUNCI
Jbenar = 0

For i = 0 To 71
If kotak(i).Text = kunci1(i) Or kotak(i).Text = kunci2(i) Then
With kotak(i)
.Font.Color = RGB(0, 0, 255)
End With
Jbenar = Jbenar + 1
Else
With kotak(i)
.Font.Color = RGB(255, 0, 0)
End With
Jbenar = Jbenar + 0
End If
Next
nilaiTTS = Round((Jbenar / 72) * 100, 2)

If nilaiTTS >= 80 Then
UserForm1.Label1.Caption = nilaiTTS
UserForm1.Show
Else
UserForm2.Label1.Caption = nilaiTTS
UserForm2.Show
End If
Worksheets(“TTSNo2”).Shapes(“Button 2”).Visible = False
End Sub

Sub kareem()
UserForm3.Show
End Sub

 

download : TTS Excel Interaktif (file xlsm)

Author: Abdul Karim

Integrasi Matematika dan Teknologi merupakan fokus perhatian saya, dalam memberikan kontribusi kepada pendidikan matematika di Indonesi

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s