今天下午，看同事準備做一個搶答節目，名字叫“一站到底”，花了好長時間用Excel錄入了近千道試題，我隨口問了句：“準備怎樣搶答？”，她說：“主持人拿著紙念，底下的人搶答。”“啊，這么老土的方式？現在用計算機多快？！”“那可不見得，你做一個試試？！”
　　原想很簡單，結果折騰了快2個小時。
　　沒有想到第二天用戶又提出了新要求，比如要求界面、不同的聲音、不同的試題集、處理數據錄入等，只好又花了一個下午來做界面、播放聲音、處理錄入等。
　　完成功能：
????????1、開始顯示封面，點擊后進入出題界面?；
????????2、先選擇試題集（共3大類29集），輸入后就可以出題；
????????3、出題時幻燈片打出試題字幕，倒計時20秒，期間顯示倒計時數和播放聲音提示，最后5秒鐘出現提示音，19秒出答案，如果沒有成功就出現失敗的聲音，中間可以打斷；
????????4、試題內容和答案在Excel文件里，也可以隨機抽題。

???????顯示封面：

????????顯示答題界面：

Declare?Function?SetTimer?Lib?"user32"?(ByVal?hwnd?As?Long,?ByVal?nIDEvent?As?Long,?ByVal?uElapse?As?Long,?ByVal?lpTimerFunc?As?Long)?As?Long
Declare?Function?KillTimer?Lib?"user32"?(ByVal?hwnd?As?Long,?ByVal?nIDEvent?As?Long)?As?Long?

Declare?Function?PlaySound?Lib?"winmm.dll"?Alias?"PlaySoundA"?(ByVal?lpszName?As?String,?ByVal?hModule?As?Long,?ByVal?dwFlags?As?Long)?As?Long
Public?Const?SND_ALIAS&?=?&H10000
Public?Const?SND_ASYNC&?=?&H1
Public?Const?SND_SYNC&?=?&H0
Public?Const?SND_NODEFAULT&?=?&H2
Public?Const?SND_FILENAME&?=?&H20000
Public?Const?SND_LOOP&?=?&H8
Public?Const?SND_PURGE&?=?&H40Public?Const?sdDefault?=?".Default"
Public?Const?sdClose?=?"Close"
Public?Const?sdEmptyRecycleBin?=?"EmptyRecycleBin"
Public?Const?sdMailBeep?=?"MailBeep"
Public?Const?sdMaximize?=?"Maximize"
Public?Const?sdMenuCommand?=?"MenuCommand"
Public?Const?sdMenuPopUp?=?"MenuPopup"
Public?Const?sdMinimize?=?"Minimize"
Public?Const?sdOpen?=?"Open"
Public?Const?sdSystemExclaimation?=?"SystemExclaimation"
Public?Const?sdSystemExit?=?"SystemExit"
Public?Const?sdSystemHand?=?"SystemHand"
Public?Const?sdSystemQuestion?=?"SystemQuestion"
Public?Const?sdSystemStart?=?"SystemStart"
'問題最小編號
Public?Const?IQuestionMinID?=?3
'問題最大編號
Public?Const?IQuestionMaxID?=?1230
'目前的編號
Public?IQuestionCurrentID?As?Integer
'試題集的編號
Public?SQuestionCollectID?As?StringDim?xlApp?As?Excel.Application
Dim?LTCount?As?Integer
Dim?SRow?As?String
Dim?STEMP?As?StringPublic?ExcelAppSound?As?Excel.Application
Public?TimerID?As?Long
Public?TimesCount?As?Integer
Public?BeStart?As?Boolean
Sub?選擇試題()
????'新建一個Excel程序
????Set?xlApp?=?New?Excel.Application
????'定義當前題庫的位置
????xlFilePath$?=?ActivePresentation.Path?&?"\員工基本知識讀本題庫之一（地質）.xls"
????'后臺打開Excel
????xlApp.Workbooks.Open?xlFilePath,?,?False

????'顯示試題內容
????ActivePresentation.Slides(1).Shapes("Rectangle?9").TextFrame.TextRange.Text?=?xlApp.Workbooks(1).Sheets(1).Cells(IQuestionCurrentID,?3)
????'清空答案
????ActivePresentation.Slides(1).Shapes("Rectangle?10").TextFrame.TextRange.Text?=?""
????'記錄答案
????ActivePresentation.Slides(1).Shapes("Rectangle?18").TextFrame.TextRange.Text?=?xlApp.Workbooks(1).Sheets(1).Cells(IQuestionCurrentID,?4)

????'關閉打開的Excel
????xlApp.Workbooks.Close
????'清空xlApp
????Set?xlApp?=?Nothing

????'準備定時器
????Dim?time?As?Integer
????time?=?20000??'每頁時間為20秒
????timerStop??'清理定時器
????'倒計時20秒
????ActivePresentation.Slides(1).Shapes("Rectangle?16").TextFrame.TextRange.Text?=?"20"
????'開始計時
????TimerStart?time
End?Sub
Sub?OnSlideShowPageChange(ByVal?Wn?As?SlideShowWindow)
????'利用Excel播放語音
????'Set?ExcelAppSound?=?New?Excel.Application
End?Sub
Sub?第一題()
????IQuestionCurrentID?=?IQuestionMinID
????'寫回
????ActivePresentation.Slides(1).Shapes("Rectangle?12").TextFrame.TextRange.Text?=?Str(IQuestionCurrentID)
????選擇試題
End?Sub
Sub?最后一題()
????IQuestionCurrentID?=?IQuestionMaxID
????'寫回
????ActivePresentation.Slides(1).Shapes("Rectangle?12").TextFrame.TextRange.Text?=?Str(IQuestionCurrentID)
????選擇試題
End?Sub
Sub?上一題()
????'獲取當前的問題編號
????STEMP?=?ActivePresentation.Slides(1).Shapes("Rectangle?12").TextFrame.TextRange.Text
????If?STEMP?=?""?Then?STEMP?=?"3"
????IQuestionCurrentID?=?Val(STEMP)
????'試題號減1
????IQuestionCurrentID?=?IQuestionCurrentID?-?1
????If?IQuestionCurrentID?<?IQuestionMinID?Then?IQuestionCurrentID?=?IQuestionMinID
????'寫回
????ActivePresentation.Slides(1).Shapes("Rectangle?12").TextFrame.TextRange.Text?=?Str(IQuestionCurrentID)
????選擇試題
End?Sub
Sub?下一題()
????'獲取當前的問題編號
????STEMP?=?ActivePresentation.Slides(1).Shapes("Rectangle?12").TextFrame.TextRange.Text
????If?STEMP?=?""?Then?STEMP?=?"3"
????IQuestionCurrentID?=?Val(STEMP)
????'試題號加1
????IQuestionCurrentID?=?IQuestionCurrentID?+?1
????If?IQuestionCurrentID?>?IQuestionMaxID?Then?IQuestionCurrentID?=?IQuestionMaxID
????'寫回
????ActivePresentation.Slides(1).Shapes("Rectangle?12").TextFrame.TextRange.Text?=?Str(IQuestionCurrentID)
????選擇試題
End?Sub
Sub?中間出結果()
????'停止計時器
????TimerID?=?KillTimer(0,?TimerID)
????BeStart?=?False
????'停止播放聲音
????Call?PlaySound(vbNullString,?0&,?SND_NODEFAULT)
????'顯示答案
????ActivePresentation.Slides(1).Shapes("Rectangle?10").TextFrame.TextRange.Text?=?ActivePresentation.Slides(1).Shapes("Rectangle?18").TextFrame.TextRange.Text
End?SubSub?OnSlideShowTerminate()
????'幻燈片結束事件處理
????'Set?ExcelAppSound?=?Nothing
????'如果計時器仍然在運行，需要結束
????TimerID?=?KillTimer(0,?TimerID)
End?SubSub?TimerStart(ByVal?time?As?Integer)
????TimesCount?=?time?/?1000
????TimerID?=?SetTimer(0,?0,?1000,?AddressOf?TimerProc)
????BeStart?=?True
End?Sub
Sub?timerStop()
????If?BeStart?=?False?Then
????????Exit?Sub
????End?If
????'停止計時
????TimesCount?=?0
????TimerID?=?KillTimer(0,?TimerID)
????BeStart?=?False
?End?SubSub?TimerProc(ByVal?hwnd?As?Long,?ByVal?uMsg?As?Long,?ByVal?idEvent?As?Long,?ByVal?dwTime?As?Long)
????'顯示時間秒數
????TimesCount?=?TimesCount?-?1
????ActivePresentation.Slides(1).Shapes("Rectangle?16").TextFrame.TextRange.Text?=?TimesCount
????'最后1秒顯示答案
????If?TimesCount?=?1?Then
???????ActivePresentation.Slides(1).Shapes("Rectangle?10").TextFrame.TextRange.Text?=?ActivePresentation.Slides(1).Shapes("Rectangle?18").TextFrame.TextRange.Text
????End?If

????'倒數5秒的處理
????If?TimesCount?<=?5?Then
????????'停止聲音
????????Call?PlaySound(vbNullString,?0&,?SND_NODEFAULT)
????????'如果需要可以播放語音念數字5、4、3、2、1
????????'ExcelAppSound.Speech.Speak?Str(TimesCount)
????????'播放最后倒計時聲音
????????Call?PlaySound(ActivePresentation.Path?&?"\提醒.wav",?0&,?SND_ASYNC?Or?SND_NODEFAULT)
????????'停止計時器
????????If?(TimesCount?<=?0)?Then
????????????Call?PlaySound(ActivePresentation.Path?&?"\時間到.wav",?0&,?SND_ASYNC?Or?SND_NODEFAULT)?'如果時間長可以加SND_LOOP避免反復調用
????????????TimerID?=?KillTimer(0,?TimerID)
????????End?If
????Else
????????Call?PlaySound(ActivePresentation.Path?&?"\計時.wav",?0&,?SND_ASYNC?Or?SND_NODEFAULT)
????End?If
????If?Not?BeStart?Then
????????TimerID?=?KillTimer(0,?TimerID)
????End?If
End?SubSub?選擇試題集()
????Load?UserForm1
????UserForm1.Show
????ActivePresentation.Slides(1).Shapes("Rectangle?19").TextFrame.TextRange.Text?=?SQuestionCollectID
End?SubSub?隱藏和顯示封面()
????ActivePresentation.Slides(1).Shapes("Rectangle?20").Visible?=?Not?ActivePresentation.Slides(1).Shapes("Rectangle?20").Visible
End?Sub

?

轉載于:https://blog.51cto.com/dawn0919/1259942

總結

以上是生活随笔為你收集整理的用幻灯片做完整的“一站到底”抢答器的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。