如何在VBA PowerPoint中生成随机的一对唯一图像

Question

如果我想创建一个随机订单以从图像中选择另一对。 ，不要重复我以前选择的随机对，即，一旦经过56个随机唯一图像即26个随机对，游戏就结束了，并重置为我的原始57张图像，然后再次选择随机对。可以在VBA PowerPoint中完成吗？

这是我正在使用的子：

Sub RandomImage()

   Dim i As Long  

   Dim posLeft As Long

   For i = 1 To 2

  Randomize

 RanNum% = Int(57 * Rnd) + 1

 Path$ = ActivePresentation.Path

 FullFileName$ = Path$ + "/" + CStr(RanNum%) + ".png"

 posLeft = 50 + ((i - 1) * 400)

 Call ActivePresentation.Slides(1).Shapes.AddPicture(FileName:=FullFileName$, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, Left:=posLeft, Top:=100, Width:=400)

Next

End Sub

Answer 1

请尝试下一个功能。它使用从1到最大必要/现有数字构建的数组。它返回rnd数组元素，然后将其从数组中消除，下次从剩余的元素中返回：

1. 请复制模块顶部上的下一个变量您使用（在声明区域中）：

  Private arrNo 
  Private Const maxNo As Long = 57 'maximum number of existing pictures

2. 在同一模块中复制下一个功能代码：

Function ReturnUniqueRndNo() As Long
   Dim rndNo As Long, filt As String, arr1Based, i As Long
   If Not IsArray(arrNo) Then
        ReDim arrNo(maxNo - 1)
        For i = 0 To UBound(arrNo): arrNo(i) = i + 1: Next i
    End If
   If UBound(arrNo) = 0 Then
        ReturnUniqueRndNo = arrNo(0)
        ReDim arrNo(maxNo - 1)
        For i = 0 To UBound(arrNo): arrNo(i) = i + 1: Next i
        MsgBox "Reset the used array..."
        Exit Function
    End If
   Randomize
   rndNo = Int((UBound(arrNo) - LBound(arrNo) + 1) * Rnd + LBound(arrNo))
   ReturnUniqueRndNo = arrNo(rndNo) 'return the array element
   filt = arrNo(rndNo) & "$$": arrNo(rndNo) = filt 'transform the array elem to be removed
   arrNo = filter(arrNo, filt, False)  'eliminate the consumed number, but returning a 0 based array...
End Function

到达限制并发送消息时，使用的数组将重置。

它可以使用下一个测试sub进行测试：

Sub testReturnUniqueRndNo()
   Dim uniqueNo As Long, i As Long
   For i = 1 To 2
        uniqueNo = ReturnUniqueRndNo
        Debug.Print uniqueNo
   Next i
End Sub

为了更快地测试，您可以修改MAXNO 20 ...

在测试它后，您必须修改代码下一个方式：

Sub RandomImage()
   Dim i As Long, posLeft As Long, RanNum%, path$, fullFileName$

   path = ActivePresentation.path
   For i = 1 To 2
        RanNum = ReturnUniqueRndNo
        fullFileName = path + "/" + CStr(RanNum) + ".png"

        posLeft = 50 + ((i - 1) * 400)

        Call ActivePresentation.Slides(1).Shapes.AddPicture(fileName:=fullFileName, _
           LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, left:=posLeft, top:=100, width:=400)
   Next
End Sub

请测试并发送一些反馈。我没有在访问中测试它，但应该可以工作...