最近單位組織了一次英語會話比賽,筆者用powerpoint內嵌的VBA功能制作了一個即時評分系統,受到老師和同學們的一致好評,現將制作過程與大家分享。
准備工作:在桌面新建一個名為“評分系統”的文件夾,用於存放參賽隊的相關信息,其中Name.txt中保存了各參賽隊名稱(需事先准備,每個隊名占一行)。
啟動工作:新建一張空白幻燈片,在“視圖”菜單下找到“工具欄”子菜單,選擇其中的“控件工具箱”(大家也可根據實際需要改變主界面風格)。調整相應控件位置,評委照片用的是“圖像控件”,下面的分數用的是“文本框”,兩個按鈕用的是“命令按鈕”,放置好控件之後再調整各控件的屬性來美化界面,也可根據實際需要插入圖片進行修飾。
評分系統主界面中包括8個評委的照片和每個評委給出的分數(如圖),功能按鈕包括“清空”、“最後得分”。
各評分得分的文本框的名稱為TxtS1,TxtS2……TxtS8,“最後得分”按鈕的名稱為CommandTotal,第二張幻燈片用來顯示最後得分的標簽名稱為LblTotal。
設計工作:打開VBA編輯器編寫代碼:
'指定文件夾用於存放每組得分的統計文件
Const Path$ = "C:windowsdesktop評分系統"
'全局變量,最後總分
Dim sum As Single
'全局變量,最後平均得分
Dim AverageScore As Single
'全局變量,記錄組次,保存後自動加1
Dim GroupNum As Integer
'清空“評委得分”,清空“最後得分”
Private Sub CommandButton1_Click()
TxtS1.Text = ""
TxtS2.Text = ""
TxtS3.Text = ""
TxtS4.Text = ""
TxtS5.Text = ""
TxtS6.Text = ""
TxtS7.Text = ""
TxtS8.Text = ""
'清空下一張幻燈片的最後總分
Slide2.LblTotal.Caption = ""
End Sub
'“最後得分”按鈕
Private Sub CommandTotal_Click()
On Error GoTo er
Dim sum As Single
'將8個評委的分數相加得出總分sum
sum = sum + CSng(TxtS1.Text)
sum = sum + CSng(TxtS2.Text)
sum = sum + CSng(TxtS3.Text)
sum = sum + CSng(TxtS4.Text)
sum = sum + CSng(TxtS5.Text)
sum = sum + CSng(TxtS6.Text)
sum = sum + CSng(TxtS7.Text)
sum = sum + CSng(TxtS8.Text)
'計算出最後得分(平均分),精確到小數點後3位
AverageScore = Format(sum / 8, "#.###")
'第二張幻燈片顯示最後得分
Slide2.LblTotal.Caption = AverageScore
'寫入最後得分
If GroupNum>=1 AND GroupNum <= 5 Then
Open Path$ && "InpScore.txt" For Append As #1
Print #1, AverageScore
Close #1
End If
GroupNum = GroupNum + 1
er:
End Sub
新建一個模塊,寫入如下代碼,此處為評獎模塊。
'評選項一等獎1名,二等獎2名,三等獎3名,故Counter變量設為6
Const Counter = 6
Public StrName(Counter) As String
Public SngScore(Counter) As Single
'模塊功能:讀取得分文件,並對得分加以排序
Public Sub ReadDataInp()
On Error GoTo er
Open Path$ && "InpName.txt" For Input As #1
For i = 1 To Counter
Input #1, StrName(i)
Next
Close #1
Open Path$ && "InpScore.txt" For Input As #2
For i = 1 To Counter
Input #2, SngScore(i)
Next
Close #2
For i = 1 To Counter
For j = 1 To Counter
If SngScore(i) > SngScore(j) Then
a = SngScore(i): SngScore(i) = SngScore(j): SngScore(j) = a
b = StrName(i): StrName(i) = StrName(j): StrName(j) = b
End If
Next
Next
er:
End Sub
新建一張幻燈片,用於顯示三等獎獲獎名單,按鈕名稱為CmdDisply,6個文本框的名稱為TxtThirdPrize1……TxtThirdPrize6。
代碼如下:
Private Sub CmdDisply_Click()
ReadDataInp
因為分數從高到低排序,因此先輸出最後三組
TxtThirdPrize1.Text = StrName(4)
TxtThirdPrize2.Text = StrName(5)
TxtThirdPrize3.Text = StrName(6)
制作時你也可以加入其他的幻燈片用做修飾,比如制作一個帶動態效果的開始畫面以及結束語等等,然後在比賽時用投影機作為輸出,一定會起到烘托賽場氣氛的作用。