SIMPAN OTOMATIS HASIL KUIS PPT DI LEMBAR EXCEL

Kami akan mengekspor / mengirim hasil Kuis PowerPoint ke Lembar Excel secara otomatis. Lembar excel harus berisi nama siswa yang dimasukkan oleh mereka dalam presentasi beserta lokasi mereka. 

Kami juga mengirimkan jumlah jawaban yang benar, jawaban yang salah, persentase dan poin yang dijamin oleh siswa ke lembar excel yang sama.

Namun fitur terbaik adalah bahwa kami mengekspor semua pertanyaan Slide PowerPoint bersama dengan jawaban yang dicoba oleh siswa ke lembar excel yang sama! Semua ini dilakukan secara otomatis!

Dim StoreQ() As String
Dim StoreA() As String
Dim StoreR() As String
Dim CurrentSlide As Integer 

Kode di atas adalah deklarasi dalam SlideLayout24 di Jendela Aplikasi Visual Basic. Kami mendeklarasikannya di atas yaitu di awal, di atas semua subrutin. 

Setelah dengan mendeklarasikannya di awal, kita dapat menggunakan variabel itu di seluruh beberapa sub-rutin dalam SlideLayout itu. Hal yang sama berlaku untuk Slide.

Namun, jika Anda ingin mendeklarasikan variabel secara global, variabel tersebut dapat digunakan dan dipanggil dalam Modul, Slide, dan SlideLayout; Anda perlu mendeklarasikannya sebagai Global CurrentSlide As Integerdalam Modul Anda (katakanlah Module1)

Bagaimanapun, setelah mendeklarasikan variabel array yang akan kami gunakan untuk menyimpan hasil Game Kuis Microsoft PowerPoint kami, kami akan mendeklarasikannya lagi (dengan demikian, ReDim) dengan jumlah kompartemen yang dimiliki oleh array kami. Dalam hal ini, saya menetapkannya sebagai jumlah slide dalam Presentasi kami karena jauh lebih nyaman:

Sub Initialise()
ReDim StoreQ(ActivePresentation.Slides.count)
ReDim StoreA(ActivePresentation.Slides.count)
ReDim StoreR(ActivePresentation.Slides.count)
End Sub 
Sub SendResultsToExcel()

Dim xlsApp As Object
Set xlsApp = CreateObject("Excel.Application")

Dim xlsWB As Object
Set xlsWB = xlsApp.Workbooks.Add

xlsWB.SaveAs ActivePresentation.Path & "\" & Slide11.TBName.Value & " - Quiz Analysis.xlsx"

xlsWB.Worksheets(1).Range("A1") = "Name"
xlsWB.Worksheets(1).Range("A2") = Slide11.TBName.Value

For i = 3 To 8
xlsWB.Worksheets(1).Range("I" & i - 1) = StoreQ(i)
xlsWB.Worksheets(1).Range("J" & i - 1) = StoreA(i)
xlsWB.Worksheets(1).Range("K" & i - 1) = StoreR(i)
Next i

xlsWB.Save
xlsWB.Close
xlsApp.Quit

MsgBox "Excel Sheet Generated!"
Set xlsWB = Nothing
Set xlsApp = Nothing

End Sub 
Sub StoreQuestion()
CurrentSlide = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
StoreQ(CurrentSlide) = ActivePresentation.Slides(CurrentSlide).Shapes("Q").TextFrame.TextRange
End Sub 
Sub Correct(CAShape As Shape)
StoreQuestion
StoreA(CurrentSlide) = CAShape.TextFrame.TextRange
StoreR(CurrentSlide) = "Correct"

Points.Caption = (Points.Caption) + 10
CA.Caption = (CA.Caption) + 1
Output = MsgBox("Your Answer is correct, well done!", vbOKOnly, "Correct Answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub 
Sub Wrong(WAShape As Shape)
StoreQuestion
StoreA(CurrentSlide) = WAShape.TextFrame.TextRange
StoreR(CurrentSlide) = "Wrong"

Points.Caption = (Points.Caption) - 5
WA.Caption = (WA.Caption) + 1
Output = MsgBox("Your Answer is wrong.", vbOKOnly, "Incorrect Answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub 

Menyimpan Pertanyaan Game Kuis PPT di Array

Array dapat menyimpan beberapa nilai dalam kompartemen yang berbeda. Berikut ini adalah contoh array yang kami gunakan untuk mengacak urutan jawaban dengan mengacak urutan “1,2,3,4”.

Dalam Array StoreQ (), StoreA (), StoreR (), kompartemen yang sesuai dari nomor slide menyimpan data. Misalnya, pertanyaan dalam slide nomor 3 disimpan di StoreQ (3).

Demikian pula, kami menyimpannya di kompartemen yang sesuai (indeks) dan kemudian kami mengekspornya ke lembar excel yang kami buat. 

For i = 3 To 8
xlsWB.Worksheets(1).Range("I" & i - 1) = StoreQ(i)
xlsWB.Worksheets(1).Range("J" & i - 1) = StoreA(i)
xlsWB.Worksheets(1).Range("K" & i - 1) = StoreR(i)
Next i 

Karena slide Pertanyaan PowerPoint kami adalah dari 3 hingga 8, angka-angka kompartemen Array yang disebutkan di atas akan berisi data yang diperlukan yaitu Pertanyaan, Jawaban yang Dicoba dan Hasil dari pertanyaan itu.

Kita dapat mengekspornya ke Sel I2 ke I7 dengan For i = 3 To 8 Loop di atas.

Simpan Hasil Kuis PowerPoint di Microsoft Excel Sheet Secara Otomatis

Kami membuat dua variabel baru: xlsApp dan xlsWB yang merupakan tipe data – Object. 
xlsApp merujuk ke 
Excel. Aplikasi xlsWB merujuk ke File Excel baru yaitu buku kerja baru yang kami buat.

Dim xlsApp As Object
Set xlsApp = CreateObject("Excel.Application")

Dim xlsWB As Object
Set xlsWB = xlsApp.Workbooks.Add

xlsWB.SaveAs ActivePresentation.Path & "\" & Slide11.TBName.Value & " - Quiz Analysis.xlsx" 

Kami kemudian dapat Menyimpan-Sebagai Buku Kerja baru yang kami buat di folder yang sama dengan file .PPTM kami dengan mendapatkan jalur tujuan file .PPTM kami melalui ActivePresentation.Path.

Anda juga dapat memasukkan lokasi Anda sendiri dengan memasukkan jalur file. Anda bisa mendapatkan lokasi file dari jendela properti file Anda.

Cukup salin-tempel itu dan masukkan “\” sehingga file disimpan di dalam folder itu. Di makro berikut, saya menyimpan File Excel saya di desktop saya. 

Pada akhirnya, ingatlah bahwa Anda menyimpannya dengan ekstensi .xlsx sehingga file terbuka di Microsoft Excel.

jalur folder
xlsWB.SaveAs "C:\Users\Bhavesh Shaha\Desktop" & "\" & Slide11.TBName.Value & " - Quiz Analysis.xlsx" 

Dalam Jalur File di atas, saya harus menggunakan “Bhavesh Shaha” yang merupakan Nama Pengguna Windows saya. Namun, ketika Anda akan membagikan Game Kuis PowerPoint ini kepada orang yang berbeda yang menjalankan file di komputer atau laptop mereka, file excel tidak akan dihasilkan karena Windows Username mereka akan berbeda.

Jadi, untuk merujuk ke Windows Username mereka di VBA, Anda harus menggunakan

Environ("Username")

Kita kemudian bisa merujuk ke sel A1 Lembar Excel kita dengan Rentang (“A1”). Kita kemudian bisa menyamakan itu dan memasukkan nilai yang harus ada di dalam sel itu. Jika Anda ingin sel memiliki string teks, cukup masukkan dalam tanda kutip ganda.

Namun, jika Anda ingin nilai variabel berada di dalam sel, Anda bisa memanggilnya tanpa tanda kutip ganda. Silakan merujuk sintaks berikut di mana kita dapat mengisi File Microsoft Excel sehingga kita dapat secara otomatis mengirim hasil permainan kuis di sana.

xlsWB.Worksheets(1).Range("A1") = "Name"
xlsWB.Worksheets(1).Range("A2") = Slide11.TBName.Value 

Anda kemudian dapat menyimpan File Excel dan Keluar dari aplikasi. Pada akhirnya, tetapkan variabel objek tersebut sebagai Tidak Ada. Ini adalah praktik yang baik untuk menghapus nilai-nilai variabel tersebut untuk menghindari komplikasi lebih lanjut. 

Sumber: https://pptvba.com/ppt-quiz-excel/

Leave a Reply

Your email address will not be published. Required fields are marked *