Pada posting ini disajikan listing program untuk membuat TTS Interaktif dengan Excel.
Kotak TTS :
Pertanyaan TTS :
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)
ABDUL KARIM 