如何在 VBA Powerpoint 中生成一对随机的独特图像

Question

如果我想从我的图片中创建一个随机订单 select 另一对。，不重复我之前选择的随机对，即一旦我浏览了 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 到最大 necessary/existing 数字构建的数组。它returnsRND数组元素，然后从数组中删除它，下次从剩下的元素返回：

请复制模块顶部的下一个变量，保留您使用的代码（在声明区域）：

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

复制同一模块中的下一个函数代码：

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

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

如何在 VBA Powerpoint 中生成一对随机的独特图像

How to Generates a random pair of unique images in VBA Powerpoint

powerpoint

vba