PPT抽奖程序故障

oldthree3333

Sub txtStart()
    For i = 1 To 5000
        With ActivePresentation.Slides(1)
            For j = 1 To 1
                With .Shapes("txtNum" & j).TextFrame.TextRange
                    .Text = Int((300 - 1 + 1) * Rnd + 1)
                    .Font.Color.RGB = 10000 * Rnd
                    Debug.Print .Text
                End With
            Next
        End With
        DoEvents
    Next
End Sub
Sub OnSlideShowTerminate()
    Exit For
End Sub
这是网上找的一段PPT随机抽奖程序，我稍加修改如下：
Sub txtStart()
  Dim a() As String
  Dim i As Integer
  Dim x As Integer
  Open "高一名单.txt" For Input As #1
  Do Until EOF(1)
    i = i + 1
    ReDim Preserve a(i) As String
    Line Input #1, a(i)
  Loop
      For x = 1 To 5000
        With ActivePresentation.Slides(1)
            For j = 1 To 1
                With .shapes("txtNum" & j).TextFrame.TextRange
                    .Text = a(Int(57 * Rnd + 1))
                    .Font.Color.RGB = 10000 * Rnd
                    Debug.Print .Text
                End With
            Next
        End With
        DoEvents
    Next
End Sub
Sub OnSlideShowTerminate()
    Exit For
End Sub
运行后名单能跑起来，但点停止后就不能再运行了，为啥？请高手指点，我对VBA一窍不通。

changxuegu

这样改应该好一些：

1. Public st As Boolean
   
2. 
   
3. Sub txtStart()
   
4. st = True
   
5.   Dim a() As String
   
6.   Dim i As Integer
   
7.   Dim x As Integer
   
8.   Open "高一名单.txt" For Input As #1
   
9.   Do Until EOF(1)
   
10.     i = i + 1
    
11.     ReDim Preserve a(i) As String
    
12.     Line Input #1, a(i)
    
13.   Loop
    
14.   t = Timer
    
15.       Do While st = True
    
16.         With ActivePresentation.Slides(1)
    
17.             If Timer >= t + 0.1 Then
    
18.                 With .Shapes("txtNum").TextFrame.TextRange
    
19.                     .Text = a(Int(7 * Rnd + 1))
    
20.                     .Font.Color.RGB = 10000 * Rnd
    
21.                 End With
    
22.                 t = Timer
    
23.             End If
    
24.         End With
    
25.         DoEvents
    
26.         
    
27.         If st = False Then Close #1: Exit Sub
    
28.     Loop
    
29. End Sub
    
30. Sub OnSlideShowTerminate()
    
31.     st = False
    
32. End Sub

复制代码

oldthree3333

首先非常感谢，我试了，还是不能运行。
18.                With .Shapes("txtNum").TextFrame.TextRange
在这一行报错，我不太懂这个东西，看不出问题在哪。

changxuegu

oldthree3333 发表于 2016-4-6 17:41
首先非常感谢，我试了，还是不能运行。
18.                With .Shapes("txtNum").TextFrame.TextRange
...

可能是文本框的名字和实际的不一致，传附件才能知道真相。

oldthree3333

这是程序的附件，麻烦您看看，谢谢！

changxuegu

oldthree3333 发表于 2016-4-11 10:09
这是程序的附件，麻烦您看看，谢谢！

已经修改，请测试

changxuegu

oldthree3333 发表于 2016-4-11 10:09
这是程序的附件，麻烦您看看，谢谢！

附件已经更新过，如果文本文件里的人数发生改变时，程序里也要做相应调整。