单击一个形状并在随机幻灯片上显示其文本

Question

我想单击一个带有文本的形状，然后让它带我到一张随机幻灯片。在那张随机幻灯片上，我希望显示我单击的形状中的文本。

我的代码将我带到随机幻灯片，但不会显示文本。

Dim lowestSlide As Integer
Dim highestSlide As Integer
Dim r As Integer

Sub PlayGame(lowestSlide As Integer, highestSlide As Integer)
    RandomSlide lowestSlide, highestSlide
    SlideShowWindows(1).View.GotoSlide (r)
    AddLetterToSlide
End Sub

Sub RandomSlide(lowestSlide As Integer, highestSlide As Integer)
    Dim slideCount As Integer
    slideCount = highestSlide - lowestSlide + 1
    
    'Create an array to keep track of which slides have already been shown
    Dim chosenSlides() As Boolean
    ReDim chosenSlides(1 To slideCount)
    
    'Begin with all slides set as not chosen
    Dim i As Integer
    For i = 1 To slideCount
        chosenSlides(i) = False
    Next
    
    'Choose a random slide that hasn't been chosen yet
    Dim chosenSlide As Integer
    Do
        chosenSlide = Int(slideCount * Rnd + 1)
    Loop While chosenSlides(chosenSlide)
    
    'Mark the chosen slide as chosen
    chosenSlides(chosenSlide) = True
    
    'Map the chosen slide number to the corresponding slide number in the PPT
    r = chosenSlide + lowestSlide - 1
End Sub

Sub Easy()
    PlayGame 21, 30
End Sub

Sub AddLetterToSlide()
    Dim selectedShape As shape
    Set selectedShape = Application.ActiveWindow.Selection.ShapeRange(1)
    Dim selectedLetter As String
    selectedLetter = Left(selectedShape.Name, 1)
    InsertLetterOrNumber selectedLetter
End Sub

Sub InsertLetterOrNumber(selectedLetter As String)
    'Add a new textbox to the slide
    Dim newTextbox As shape
    Set newTextbox = ActivePresentation.Slides(r).Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=ActivePresentation.Slides(r).Master.Width - (5 * 72), _
        Top:=0, Width:=5 * 72, Height:=2 * 72)
    
    'Set the textbox properties
    With newTextbox
        .Line.ForeColor.RGB = RGB(0, 0, 0) 'Black border
        .Fill.ForeColor.RGB = RGB(255, 255, 255) 'White background
        .TextFrame.TextRange.Text = selectedLetter 'Text to display
        .TextFrame.TextRange.Font.Name = "Arial" 'Font name
        .TextFrame.TextRange.Font.Size = 24 'Font size
        .TextFrame.TextRange.Find.Color.RGB = RGB(0, 0, 0) 'Font color
        .TextFrame.TextRange.Font.Bold = msoTrue
        .TextFrame.TextRange.Font.Italic = msoTrue
        .TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignRight 'Align text to the right
        .ZOrder msoBringToFront 'Bring textbox to front
    End With
End Sub

假设我单击一个名为 A 的形状，其中包含字母 A。
单击该形状时，它会运行宏

Easy()

。

我想要

1. 将该形状的名称存储为“selectedLetter”
2. 在所选宏的范围内随机选择一张幻灯片，在本例中为 21 到 30
3. 使用数组来跟踪之前选择的幻灯片，以便同一张幻灯片不会显示两次
4. 转到那张幻灯片
5. 在右上角创建一个形状，然后在该形状内写入“selectedLetter”的值

我尝试更改子例程的执行顺序。我尝试使用文本框而不是形状。我尝试使用现有的形状和文本框，而不是尝试创建它们。

我知道

Dim newTextbox As shape

应该是

Dim newTextbox As Shape

。每次我尝试修复它时，它都会变回

shape

。

我忘记了为什么我将三个 Dim 变量设置为全局变量。可能是一次失败的故障排除尝试。

Answer 1

这是一个基本示例：

Option Explicit

Dim colSlides As Collection

'initialize slides collection from slide 2 to slide 20
Sub Reset()
    Dim i As Long
    Set colSlides = New Collection
    For i = 2 To 20
        colSlides.Add ActivePresentation.Slides(i)
    Next i
End Sub

'called from shapes on slide #1
' `shp` will be the clicked-on shape
Sub Play(shp As Shape)
    Dim pick As Long, sld As Slide
    
    Debug.Print shp.Name
    pick = RandBetween(1, colSlides.Count)  'pick from the remaining slides
    Debug.Print pick
    Set sld = colSlides(pick)               'reference selected slide
    colSlides.Remove pick                   '...and remove it from the collection
    
    SlideShowWindows(1).View.GotoSlide sld.SlideIndex
    With sld.Shapes.AddTextbox(msoOrientationHorizontal, 10, 10, 300, 50)
        'copy the text from the clicked-on shape into the slide
        .TextFrame.TextRange.Text = shp.TextFrame.TextRange.Text
    End With
    
End Sub

'return a whole number between `vLow` and `vHigh`
Function RandBetween(vLow As Long, vHigh As Long)
    RandBetween = Int(vLow + (vHigh - vLow + 1) * Rnd())
End Function