PPT使用VBA宏编程实现随机点名以及生成点名需要的列表

一、准备工作

所需设备与软件

• 一台电脑
• Microsoft PowerPoint（WPS Office也可以，但需安装插件）
• 一双勤劳的手

开启开发工具和宏设置

1、打开你的PowerPoint演示文稿，点击左上角 文件→更多→选项 

2、开启自定义功能区中的开发工具

 3、打开 信任中心→宏设置→启用所以宏

        信任中心→ActiveX设置→无限制启用所有控价并且不进行提示（按需关闭下方的安全模式）

二、编写随机点名的程序

1、回到ppt，使用开发工具的控件创建一个命令按钮

2、双击命令按钮来到vba编辑界面，用如下代码进行替换（有注释，按需修改）

Private Sub CommandButton1_Click()
    Dim slideIndex As Integer
    Dim Slide As Slide
    Dim shape As shape
    Dim namesList As Collection
    Dim name As Variant
    Dim randomIndex As Integer
    Dim nameText As String

    ' 设置幻灯片索引（假设第2张幻灯片是名单幻灯片）
    slideIndex = 2
    Set Slide = ActivePresentation.Slides(slideIndex)

    ' 创建一个集合存储所有名字
    Set namesList = New Collection

    ' 遍历幻灯片中的所有形状
    For Each shape In Slide.Shapes
        ' 如果形状是文本框（适合存储名字）
        If shape.HasTextFrame Then
            If shape.TextFrame.HasText Then
                namesList.Add shape.TextFrame.TextRange.Text
            End If
        End If
    Next shape

    ' 如果没有找到任何名字
    If namesList.Count = 0 Then
        MsgBox "没有找到任何名字，请检查名单幻灯片！", vbExclamation
        Exit Sub
    End If

    ' 随机选择一个名字
    Randomize
    randomIndex = Int((namesList.Count) * Rnd + 1)

    ' 获取随机选择的名字
    nameText = namesList.Item(randomIndex)

    ' 在幻灯片中显示选中的名字（可选择在第1张幻灯片显示结果）
    'ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = "本次点名结果: " & nameText

    ' 弹出消息框显示随机选择的名字
    MsgBox "恭喜！点到的是: " & nameText, vbInformation, "点名结果"
End Sub

代码说明：

• 该代码首先获取幻灯片 2 中的所有文本框内容，并将其添加到 namesList 集合中。
• 然后，使用 Randomize 和 Rnd 函数随机选取一个名字，并通过消息框弹出显示。

 三、生成适用的名字列表

1、左侧单击鼠标右键创建一个模块

2、将如下代码粘贴进去(都有注释，按需修改)，并且运行

Sub SplitNamesToTextBoxes()
    Dim Slide As Slide
    Dim shape As shape
    Dim names As Variant
    Dim i As Integer
    Dim newShape As shape
    Dim topPosition As Single
    
    ' 定义名字列表
    names = Array("龙飞凤舞", "举世无敌", "大展宏图", "如虎添翼", "临渊羡鱼", "心旷神怡", _
                  "临渊羡鱼", "心旷神怡", "百年树人", "一举成名", "无可奈何", "事半功倍", _
                  "声东击西", "青出于蓝", "风华正茂", "一心一意", "口若悬河", "月满则亏", _
                  "众口铄金", "自力更生")

    ' 获取当前幻灯片
    Set Slide = ActivePresentation.Slides(2) ' 可以修改为适当的幻灯片索引
    
    ' 初始化新文本框的顶部位置
    topPosition = 50 ' 从上方50px开始显示
    
    ' 遍历名字列表并逐行创建文本框
    For i = LBound(names) To UBound(names)
        ' 创建新的文本框并逐行填充
        Set newShape = Slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, topPosition, 600, 30)
        newShape.TextFrame.TextRange.Text = names(i)
        topPosition = topPosition + newShape.Height + 10 ' 更新顶部位置，确保文本框不重叠
    Next i
End Sub

代码说明：

• 该代码定义了一个包含多个名字的数组 names，然后在幻灯片 2 上动态创建文本框，将每个名字逐一显示。
• 每个文本框都会自动调整位置，以防止重叠。

 

四、大功告成，效果如下

​​​​​​​