如何使用 VBA (Excel) 在 Powerpoint 幻灯片上随机放置测验答案按钮？

编程问答 2022-05-17

问题描述

背景：

我正在尝试使用 powerpoint 创建一个测验，其中每张幻灯片上有四个按钮（正确答案、错误答案、错误答案、错误答案）。根据选择的内容，用户将被重定向到不同的幻灯片。为了让玩家更困难，我想随机化答案按钮的位置，例如随机交换正确答案位置、错误答案位置等

enter image description here

Presentation and Spreadsheet files on OneDrive

目标：

我试图通过 excel 使用 vba 首先找到每个幻灯片上每个形状的顶部和左侧坐标。然后第二次循环播放演示文稿，随机排列我的回答按钮的位置（随机交换它们）。

说明：

我的每个答案按钮都由两部分组成，一个透明的矩形形状（根据用户是否选择了正确或错误的答案，它具有指向特定幻灯片的操作链接）以及一个文本字段（带有红色背景）表示错误或正确答案。

问题：

我目前在存储每张幻灯片上每个形状的顶部和左侧坐标时遇到问题。这样我就可以循环浏览每张幻灯片并随机放置我的潜在答案按钮。

到目前为止 我能够在本地访问和存储每个形状的顶部和左侧位置，但我无法将它们存储在我的嵌套类中。相反，当我尝试将在特定幻灯片上找到的形状数组传递到我的一个类时，每次我尝试访问此传递数组时，即使我知道正在传递值，它也会显示为空。

Any suggestions would be fantastic

我的代码：

模块 1

Option Explicit

Sub CreateQuiz()

    Dim oPPApp      As Object,oPPPrsn As Object,oPPSlide As Object
    Dim oPPShape    As Object
    Dim FlName      As String
  

             '~~> Change this to the relevant file
    FlName = ThisWorkbook.Path & "/Quiz.pptm"


    
    '~~> Establish an PowerPoint application object
    On Error Resume Next
    Set oPPApp = Getobject(,"PowerPoint.Application")
    
    If Err.Number <> 0 Then
        Set oPPApp = CreateObject("PowerPoint.Application")
    End If
    oPPApp.Visible = False
    
    
    Set oPPPrsn = oPPApp.Presentations.Open(FlName,True)
    
 Dim currentPresentation As New Presentation
         Dim numSlides As Integer
        numSlides = 0
    For Each oPPSlide In oPPPrsn.Slides
        Dim currentSlide As New shapesOnSlide
        Dim numShapes As Integer
        numShapes = 0
        For Each oPPShape In oPPSlide.shapes

                     Dim currentShape As New shapeDetails
                    currentShape.slideNumber = oPPSlide.slideNumber
                    currentShape.name = oPPShape.name
                    currentShape.left = oPPShape.left
                    currentShape.top = oPPShape.top
                      
                    currentSlide.size = numShapes
                    currentSlide.aShape = currentShape
     
        numShapes = numShapes + 1
        Next
       
       currentPresentation.Slide(numSlides) = currentSlide

        numSlides = numSlides + 1
    Next
    currentPresentation.printAll
    
End Sub

ShapeDetails 类

Private ElementSlideNumber As Integer
Private ElementName As String
Private ElementLeft As Double
Private ElementTop As Double

Public Property Get slideNumber() As Integer
    slideNumber = ElementSlideNumber
End Property

Public Property Let slideNumber(value As Integer)
    ElementSlideNumber = value
End Property

Public Property Get name() As String
    name = ElementName
End Property

Public Property Let name(value As String)
    ElementName = value
End Property

Public Property Get left() As Double
    left = ElementLeft
End Property

Public Property Let left(value As Double)
    ElementLeft = value
End Property

Public Property Get top() As Double
    top = ElementTop
End Property

Public Property Let top(value As Double)
    ElementTop = value
End Property

Public Sub Printvars()
    Debug.Print "Slide: " & slideNumber & " Position: " & left & "," & top & ",Slide Name: " & name
    
End Sub

shapesonSlide 类

Private allShapes(99999) As Variant
Private collectionSize As Integer



Public Property Get size() As Integer
    size = collectionSize
End Property

Public Property Let size(value As Integer)
    collectionSize = value
End Property



Public Property Get aShape() As Variant
    shapes = allShapes(collectionSize)
End Property

Public Property Let aShape(value As Variant)
    allShapes(collectionSize) = value
End Property


Public Property Get everyShape() As Variant
    everyShape = allShapes()
End Property

Public Property Let everyShape(value As Variant)
    everyShape = value
End Property



Sub compareSizes(newIndex As Integer)
If (newIndex > collectionSize) Then
collectionSize = newIndex
End If
End Sub

Public Sub printSize()
Debug.Print collectionSize
End Sub

演示课

Private allSlides() As shapesOnSlide

Private Sub Class_Initialize()
    ReDim allSlides(0)
End Sub

Public Property Get Slides() As shapesOnSlide()
    Slides = allSlides
End Property

Public Property Get Slide(index As Integer) As shapesOnSlide
    Slide = allSlides(index)
End Property

Public Property Let Slide(index As Integer,currentSlide As shapesOnSlide)
    If index > UBound(allSlides) Then ReDim Preserve allSlides(index)
    allSlides(index) = currentSlide
End Property

Public Sub printAll()
    For Each currentSlide In allSlides
    For Each currentShape In currentSlide.everyShape
    
         Debug.Print currentShape.name
    Next
    Next
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

classclassclassexcelexcelpowerpointpowerpointshapesvba