Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Sub sleep(ts) '线程睡眠函数
Dim t, t1
t = timeGetTime
Do
t1 = timeGetTime
If t1 < t Then t1 = 86400 + t1
DoEvents
Loop Until t1 - ts > t
End Sub
Sub run_it()
Debug.Print "theClassIndex=" & theClassIndex
Debug.Print "theIndex=" & theIndex
If status Then '停下来
status = False
ActivePresentation.Slides(1).Shapes("Rounded Rectangle 6").Visible = msoTrue '开始
ActivePresentation.Slides(1).Shapes("Rounded Rectangle 14").Visible = msoFalse '停止
Else '开始动画
If theClassIndex = -1 Then
MsgBox "全部开始已完成，如要保存结果请保存此PPT。" & vbCrLf & "如要全部重新开始，请点重置！"
Exit Sub
End If
'Debug.Print "进来了1"
status = True
ActivePresentation.Slides(1).Shapes("Rounded Rectangle 14").Visible = msoTrue '停止
ActivePresentation.Slides(1).Shapes("Rounded Rectangle 6").Visible = msoFalse '开始
'Debug.Print "进来了2"
Savetime = timeGetTime '记下开始的时间
Dim k As Integer
k = 0
Do While status
Savetime = timeGetTime '记下开始的时间
Debug.Print Savetime
If k < UBound(sh_name_arr) Then
ActivePresentation.Slides(1).Shapes("TextBox 5").TextFrame.TextRange.Text = sh_name_arr(k)
Debug.Print "旋转" & k & sh_name_arr(k)
k = k + 1
Else
k = 0
ActivePresentation.Slides(1).Shapes("TextBox 5").TextFrame.TextRange.Text = sh_name_arr(k)
Debug.Print "旋转" & k & sh_name_arr(k)
k = k + 1
End If
sleep (50)
Loop
Exit Sub '还没有点停，不抽出
End If
'不是动画时，做其他事，写这里
End Sub