This afternoon, I watched my colleague prepare for a Q & A program named "one stop to the end". It took me a long time to enter nearly a thousand questions in Excel. I casually asked: "How to answer questions? ", She said: "The Host reads paper and the people below answer the question ." "Ah, this old method? How fast is the computer used now ?!" "That's not the case. Do you have a try ?!"
The original thought was very simple, and it took about two hours.
I did not expect that the user raised new requirements on the next day, such as the requirement page, different voices, different question sets, and data input, I had to spend another afternoon on the interface, playing sound, and processing input.
Completed functions:
1. Start to display the cover. Click it to go to the question page;
2. Select the test set in three categories and 29 sets). After Entering the test set, you can issue the question;
3. When a question is displayed, subtitles are displayed on the slide, and the countdown is 20 seconds. The Countdown count and playback sound are displayed, the prompt is displayed in the last 5 seconds, and the answer is displayed in 19 seconds, if the call fails, you can interrupt it;
4. Questions and answers can be randomly selected in an Excel file.
Show cover:
650) this. width = 650; "title =" 1.jpg" src = "http://img1.51cto.com/attachment/201308/195253771.jpg"/>
The answer page is displayed:
650) this. width = 650; "title =" 2.jpg" src = "http://www.bkjia.com/uploads/allimg/131228/1603515N0-1.jpg"/>
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"
'The minimum problem ID
Public Const IQuestionMinID = 3
'The maximum number of problems
Public Const IQuestionMaxID = 1230.
'Current ID
Public IQuestionCurrentID As Integer
'Question set no.
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 select question ()
'Create an Excel program
Set xlApp = New Excel. Application
'Define the location of the current question Library
XlFilePath $ = ActivePresentation. Path & "\ the basic knowledge of the employee. xls"
'Open Excel in the background
XlApp. Workbooks. Open xlFilePath, False
'Show question content
ActivePresentation. Slides (1). Shapes ("Rectangle 9"). TextFrame. TextRange. Text = xlApp. Workbooks (1). Sheets (1). Cells (IQuestionCurrentID, 3)
'Clear the answer
ActivePresentation. Slides (1). Shapes ("Rectangle 10"). TextFrame. TextRange. Text = ""
'Record the answer
ActivePresentation. Slides (1). Shapes ("Rectangle 18"). TextFrame. TextRange. Text = xlApp. Workbooks (1). Sheets (1). Cells (IQuestionCurrentID, 4)
'Close opened Excel
XlApp. Workbooks. Close
'Clear xlApp
Set xlApp = Nothing
'Prepare the timer
Dim time As Integer
Time = 20000 'time per page is 20 seconds
TimerStop 'cleanup Timer
'Countdown 20 seconds
ActivePresentation. Slides (1). Shapes ("Rectangle 16"). TextFrame. TextRange. Text = "20"
'Start timing
TimerStart time
End Sub
Sub OnSlideShowPageChange (ByVal Wn As SlideShowWindow)
'Use Excel to play the voice
'Set ExcelAppSound = New Excel. Application
End Sub
Sub ()
IQuestionCurrentID = IQuestionMinID
'Write-back
ActivePresentation. Slides (1). Shapes ("Rectangle 12"). TextFrame. TextRange. Text = Str (IQuestionCurrentID)
Select question
End Sub
Sub last question ()
IQuestionCurrentID = IQuestionMaxID
'Write-back
ActivePresentation. Slides (1). Shapes ("Rectangle 12"). TextFrame. TextRange. Text = Str (IQuestionCurrentID)
Select question
End Sub
Sub previous question ()
'Get the current question ID
STEMP = ActivePresentation. Slides (1). Shapes ("Rectangle 12"). TextFrame. TextRange. Text
If STEMP = "" Then STEMP = "3"
IQuestionCurrentID = Val (STEMP)
'Question No. Minus 1
IQuestionCurrentID = IQuestionCurrentID-1
If IQuestionCurrentID <IQuestionMinID Then IQuestionCurrentID = IQuestionMinID
'Write-back
ActivePresentation. Slides (1). Shapes ("Rectangle 12"). TextFrame. TextRange. Text = Str (IQuestionCurrentID)
Select question
End Sub
Sub next question ()
'Get the current question ID
STEMP = ActivePresentation. Slides (1). Shapes ("Rectangle 12"). TextFrame. TextRange. Text
If STEMP = "" Then STEMP = "3"
IQuestionCurrentID = Val (STEMP)
'Question No. Plus 1
IQuestionCurrentID = IQuestionCurrentID + 1
If IQuestionCurrentID> IQuestionMaxID Then IQuestionCurrentID = IQuestionMaxID
'Write-back
ActivePresentation. Slides (1). Shapes ("Rectangle 12"). TextFrame. TextRange. Text = Str (IQuestionCurrentID)
Select question
End Sub
Sub intermediate output result ()
'Stop the timer
TimerID = KillTimer (0, TimerID)
BeStart = False
'Stop Playing sound
Call PlaySound (vbNullString, 0 &, SND_NODEFAULT)
'Show the answer
ActivePresentation. slides (1 ). shapes ("Rectangle 10 "). textFrame. textRange. text = ActivePresentation. slides (1 ). shapes ("Rectangle 18 "). textFrame. textRange. text
End SubSub OnSlideShowTerminate ()
'Processing the slide end event
'Set ExcelAppSound = Nothing
'If the timer is still running, end it.
TimerID = KillTimer (0, TimerID)
End SubSub TimerStart (ByVal time As Integer)
TimesCount = time/1000
TimerID = SetTimer (0, zero, 1000, AddressOf TimerProc)
BeStart = True
End Sub
Sub timerStop ()
If BeStart = False Then
Exit Sub
End If
'Stop timing
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)
'Display time in seconds
TimesCount = TimesCount-1
ActivePresentation. Slides (1). Shapes ("Rectangle 16"). TextFrame. TextRange. Text = TimesCount
'The answer displayed in the last 1 second
If TimesCount = 1 Then
ActivePresentation. slides (1 ). shapes ("Rectangle 10 "). textFrame. textRange. text = ActivePresentation. slides (1 ). shapes ("Rectangle 18 "). textFrame. textRange. text
End If
'Processing in 5 seconds
If TimesCount <= 5 Then
'Stop the sound
Call PlaySound (vbNullString, 0 &, SND_NODEFAULT)
'If you want to play the voice, read the numbers 5, 4, 3, 2, and 1.
'Excelappsound. Speech. Speak Str (TimesCount)
'The last playback countdown sound
Call PlaySound (ActivePresentation. Path & "\ .wav", 0 &, SND_ASYNC Or SND_NODEFAULT)
'Stop the timer
If (TimesCount <= 0) Then
Call PlaySound (ActivePresentation. Path & "\ time to .wav", 0 &, SND_ASYNC Or SND_NODEFAULT) 'if it takes a long time, you can add SND_LOOP to avoid repeated calls
TimerID = KillTimer (0, TimerID)
End If
Else
Call PlaySound (ActivePresentation. Path & "\ timing .wav", 0 &, SND_ASYNC Or SND_NODEFAULT)
End If
If Not BeStart Then
TimerID = KillTimer (0, TimerID)
End If
End SubSub select question set ()
Load UserForm1
UserForm1.Show
ActivePresentation. Slides (1). Shapes ("Rectangle 19"). TextFrame. TextRange. Text = SQuestionCollectID
End SubSub hide and show cover ()
ActivePresentation. Slides (1). Shapes ("Rectangle 20"). Visible = Not ActivePresentation. Slides (1). Shapes ("Rectangle 20"). Visible
End Sub
This article is from the "CSharp" blog, please be sure to keep this source http://dawn0919.blog.51cto.com/2954252/1259942
