请问各位大佬，抽奖代码为什么无法运行？

gbabc

用的是Microsoft PowerPoint 2016，想弄个抽奖程序，要求：在当前页面，创建一个显示框，当点击开始按钮时，框内随机滚动显示本地文件夹内的图片。当点击停止按钮时，停止滚动。实测代码无法运行，请各位大佬指点，先谢了。

1. Sub 创建抽奖框()
   
2.     Dim shp As Shape
   
3.     Dim btn1 As Shape
   
4.     Dim btn2 As Shape
   
5.     Dim rng As Range
   
6.     Dim picName As String
   
7.    
   
8.     '创建一个显示框
   
9.     Set shp = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 100, 100, 500, 300)
   
10.     shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
    
11.     shp.Line.ForeColor.RGB = RGB(0, 0, 0)
    
12.    
    
13.     '创建一个开始按钮，并分配宏
    
14.     Set btn1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRoundedRectangle, 150, 450, 100, 50)
    
15.     btn1.Fill.ForeColor.RGB = RGB(0, 255, 0)
    
16.     btn1.Line.ForeColor.RGB = RGB(0, 0, 0)
    
17.     btn1.TextFrame.TextRange.Text = "开始"
    
18.     btn1.ActionSettings(ppMouseClick).Run = "开始"
    
19.    
    
20.     '创建一个停止按钮，并分配宏
    
21.     Set btn2 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRoundedRectangle, 450, 450, 100, 50)
    
22.     btn2.Fill.ForeColor.RGB = RGB(255, 0, 0)
    
23.     btn2.Line.ForeColor.RGB = RGB(0, 0, 0)
    
24.     btn2.TextFrame.TextRange.Text = "停止"
    
25.     btn2.ActionSettings(ppMouseClick).Run = "停止"
    
26.    
    
27. End Sub
    
28. 
    
29. Sub 开始()
    
30.     '设置图片的路径和文件夹
    
31.     Const picPath As String = "D:\抽奖图片"
    
32.     Const picFolder As String = "抽奖图片"
    
33.    
    
34.     '获取图片的文件名列表
    
35.     Dim picList() As String
    
36.     Dim picCount As Long
    
37.     Dim fso As Object
    
38.     Dim fld As Object
    
39.     Dim fil As Object
    
40.    
    
41.     Set fso = CreateObject("Scripting.FileSystemObject")
    
42.     Set fld = fso.GetFolder(picPath)
    
43.    
    
44.     For Each fil In fld.Files
    
45.         If UCase(fil.Name) Like "*.JPG" Or UCase(fil.Name) Like "*.PNG" Then
    
46.             ReDim Preserve picList(picCount)
    
47.             picList(picCount) = fil.Name
    
48.             picCount = picCount + 1
    
49.         End If
    
50.     Next fil
    
51.    
    
52.     '随机选择一个图片文件名，并插入到显示框中
    
53.     Dim shp As Shape
    
54.     Dim rng As Range
    
55.     Dim picName As String
    
56.    
    
57.     Set shp = ActivePresentation.Slides(1).Shapes(1) '假设显示框是第一个形状，可以根据需要修改
    
58.    
    
59.     Randomize '初始化随机数种子
    
60.    
    
61.     Do While SlideShowWindows.Count > 0 '当幻灯片放映时，循环执行以下代码
    
62.         
    
63.         '删除原有的图片（如果有）
    
64.         On Error Resume Next
    
65.         shp.Shapes(1).Delete
    
66.         
    
67.         '随机选择一个图片文件名，并拼接完整的路径
    
68.         picName = picList(Int(Rnd * picCount))
    
69.         picName = picPath & picName
    
70.         
    
71.         '在显示框中插入图片，并调整位置和大小
    
72.         With shp.Shapes.AddPicture(picName, False, True, -1, -1, -1, -1)
    
73.             .LockAspectRatio = msoTrue '保持纵横比
    
74.             
    
75.             If .Height / .Width > shp.Height / shp.Width Then '根据显示框和图片的纵横比，确定缩放比例
    
76.                 .Height = shp.Height - 10 '留出一些边距
    
77.                 .Left = shp.Left + (shp.Width - .Width) / 2 '水平居中
    
78.                 .Top = shp.Top + 5 '垂直居上
    
79.             Else
    
80.                 .Width = shp.Width - 10 '留出一些边距
    
81.                 .Top = shp.Top + (shp.Height - .Height) / .Left = shp.Left + 5 '水平居左
    
82.             End If
    
83.         End With
    
84.         
    
85.         DoEvents '处理其他事件，例如点击停止按钮
    
86.         
    
87.     Loop
    
88.    
    
89. End Sub
    
90. 
    
91. Sub 停止()
    
92.     '停止幻灯片放映
    
93.     SlideShowWindows(1).View.State = ppSlideShowDone
    
94. End Sub

复制代码