如何解决如何使用 VBA (Excel) 在 Powerpoint 幻灯片上随机放置测验答案按钮?
背景:
我正在尝试使用 powerpoint 创建一个测验,其中每张幻灯片上有四个按钮(正确答案、错误答案、错误答案、错误答案)。根据选择的内容,用户将被重定向到不同的幻灯片。为了让玩家更困难,我想随机化答案按钮的位置,例如随机交换正确答案位置、错误答案位置等
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 举报,一经查实,本站将立刻删除。