Media Animasi Memindahkan Ikan dengan VBA Excel

Membuat Kode untuk membuat animasi gambar VBA for Excel

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

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

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

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

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

Sub kiri()

Range(“I11”) = 1

End Sub

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

Sub kanan()

Range(“I11”) = 0

End Sub

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 Sub

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 Sub

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 Sub

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 Sub

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 Sub

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 Sub

Sub tujuh()

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 Sub

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 Sub

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 Sub

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