Materi Perkuliahan

Media Animasi Memindahkan Ikan dengan VBA Excel

Dipublikasikan pada : 7 Februari 2021.

Membuat Kode untuk membuat animasi gambar VBA for Excel

  1. Membuat bilangan asli dengan memasukan jumlah ikan

Sub masukan()

Dim lembar As Worksheet

Set lembar = Worksheets(1)

Range(“A1”) = Range(“A1”) + 1

lembar.Shapes(“ikan”).Duplicate.Name = “ikan” & Range(“A1”)

lembar.Shapes(“ikan” & Range(“A1”)).Left = Cells(2, 2 + Range(“A1”)).Left

lembar.Shapes(“ikan” & Range(“A1”)).Top = Cells(2, 2 + Range(“A1”)).Top

Range(“R2”) = Range(“R2”) + 1

End Sub

 

  1. Memasukan kode untuk memindahkan ikan ke kolam 1

Sub pindah1()

Dim lembar As Worksheet

Set lembar = Worksheets(1)

Application.OnTime Now + TimeValue(“00:00:01”), “pindah1”

lembar.Shapes(“pipa1”).Fill.ForeColor.RGB = vbBlue

Range(“A6”) = Range(“A6”) + 1

lembar.Shapes(“lingkar”).Rotation = Range(“A6”) * 90

If Range(“A6”) = 4 Then

Range(“B7”) = Range(“B7”) + 1

Range(“A7”) = Range(“A7”) + 1

Range(“A8”) = Range(“A8”) + 1

Range(“A1”) = Range(“A1”) – 1

Range(“A6”) = 0

lembar.Shapes(“pipa1”).Fill.ForeColor.RGB = vbWhite

If Range(“A7”) > 4 Then

Range(“B6”) = Range(“B6”) + 1

Range(“A7”) = 1

End If

lembar.Shapes(“ikan” & Range(“A8”)).Left = Cells(11 – Range(“B6”), 2 + Range(“A7”)).Left

lembar.Shapes(“ikan” & Range(“A8”)).Top = Cells(11 – Range(“B6”), 2 + Range(“A7”)).Top

Application.OnTime Now + TimeValue(“00:00:01”), “pindah1”, , False

End If

End Sub

 

  1. Membuat Kode untuk kembali ke semula

Sub hapus()

On Error Resume Next

Dim lembar As Worksheet

Set lembar = Worksheets(1)

For i = 1 To 14

lembar.Shapes(“ikan” & i).Delete

Next i

lembar.Shapes(“datar”).Visible = msoTrue

lembar.Shapes(“senang”).Visible = msoFalse

lembar.Shapes(“sedih”).Visible = msoFalse

lembar.Shapes(“bintang”).Visible = msoFalse

Range(“A1”) = 0

Range(“A7”) = 0

Range(“B6”) = 0

Range(“A8”) = 0

Range(“O7”) = 0

Range(“P6”) = 0

Range(“D13”) = “”

Range(“L13”) = “”

Range(“R2”) = 0

Range(“B7”) = 0

Range(“P7”) = 0

Application.OnTime Now + TimeValue(“00:00:01”), “cekdata”, , False

End Sub

 

  1. Membuat Kode memindahkan ikan ke kolam 2

Sub pindah2()

Dim lembar As Worksheet

Set lembar = Worksheets(1)

Application.OnTime Now + TimeValue(“00:00:01”), “pindah2”

lembar.Shapes(“pipa2”).Fill.ForeColor.RGB = vbBlue

Range(“O6”) = Range(“O6”) + 1

lembar.Shapes(“lingkar1”).Rotation = Range(“O6”) * 90

If Range(“O6”) = 4 Then

Range(“P7”) = Range(“P7”) + 1

Range(“O7”) = Range(“O7”) + 1

Range(“A8”) = Range(“A8”) + 1

Range(“A1”) = Range(“A1”) – 1

Range(“O6”) = 0

lembar.Shapes(“pipa2”).Fill.ForeColor.RGB = vbWhite

If Range(“O7”) > 4 Then

Range(“P6”) = Range(“P6”) + 1

Range(“O7”) = 1

End If

lembar.Shapes(“ikan” & Range(“A8”)).Left = Cells(11 – Range(“P6”), 10 + Range(“O7”)).Left

lembar.Shapes(“ikan” & Range(“A8”)).Top = Cells(11 – Range(“P6”), 10 + Range(“O7”)).Top

Application.OnTime Now + TimeValue(“00:00:01”), “pindah2”, , False

End If

End Sub

 

  1. Kode untuk membuat kondisi Menuliskan angka untuk menyatakan jumlah ikan pada kolam 1

 

Sub kiri()

Range(“I11”) = 1

End Sub

 

  1. Kode untuk membuat kondisi Menuliskan angka untuk menyatakan jumlah ikan pada kolam 2

 

Sub kanan()

Range(“I11”) = 0

End Sub

 

  1. Kode untuk menuliskan angka 1

Sub satu()

If Range(“I11”) = 1 Then

Range(“D13”) = 1

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 1

End If

End If

End Sub

 

  1. Kode untuk menuliskan angka 2

Sub dua()

If Range(“I11”) = 1 Then

Range(“D13”) = 2

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 2

End If

End If

End Sub

 

  1. Kode untuk menuliskan angka 3

Sub tiga()

If Range(“I11”) = 1 Then

Range(“D13”) = 3

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 3

End If

End If

End Sub

 

  1. Kode untuk menuliskan angka 4

 

Sub empat()

If Range(“I11”) = 1 Then

Range(“D13”) = 4

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 4

End If

End If

End Sub

 

  1. Kode untuk menuliskan angka 5

 

Sub lima()

If Range(“I11”) = 1 Then

Range(“D13”) = 5

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 5

End If

End If

End Sub

 

  1. Kode untuk menuliskan angka 6

 

Sub enam()

If Range(“I11”) = 1 Then

Range(“D13”) = 6

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 6

End If

End If

End Sub

Sub tujuh()

 

  1. Kode untuk menuliskan angka 7

If Range(“I11”) = 1 Then

Range(“D13”) = 7

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 7

End If

End If

End Sub

 

 

  1. Kode untuk menuliskan angka 8

 

Sub delapan()

If Range(“I11”) = 1 Then

Range(“D13”) = 8

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 8

End If

End If

End Sub

 

  1. Kode untuk menuliskan angka 9

Sub sembilan()

If Range(“I11”) = 1 Then

Range(“D13”) = 9

Else

If Range(“I11”) = 0 Then

Range(“L13”) = 9

End If

End If

End Sub

 

  1. Kode untuk mengecek benar dan salah pada jawaban siswa PAUD

Sub cekdata()

Dim lembar As Worksheet

Set lembar = Worksheets(1)

lembar.Shapes(“datar”).Visible = msoFalse

If Range(“D13”) = Range(“B7”) And Range(“L13”) = Range(“p7”) Then

Application.OnTime Now + TimeValue(“00:00:01”), “cekdata”

lembar.Shapes(“bintang”).IncrementRotation 6

lembar.Shapes(“bintang”).Visible = msoTrue

lembar.Shapes(“sedih”).Visible = msoFalse

lembar.Shapes(“senang”).Visible = msoTrue

Else

lembar.Shapes(“senang”).Visible = msoFalse

lembar.Shapes(“bintang”).Visible = msoFalse

lembar.Shapes(“sedih”).Visible = msoTrue

End If

End Sub

 

id_IDIndonesian
id_IDIndonesian