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

Question

If I want to create a random order to select another pair from my image. , not repeating the random pair i've previously picked, i.e. so that once i've gone through 56 random unique images i.e. 26 random pairs, the game is over, and reset to my original 57 images and start picking random pairs again. Can this be done in VBA Powerpoint?

This is the sub I am using:

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

You could generate a [random array](https://stackoverflow.com/a/18543399/17172829) of you numbers (1-56) and then loop this array. — Shrotter, May 17 '22 at 12:03
I don't know how to modify it to fit my current sub. Can you write sub for me? ༼ つ ◕_◕ ༽つPlease — Siriwan Polpangkwa, May 17 '22 at 13:34
Did you try the answer code I posted? Do you use MAC Access version? I am asking because of the used path separator ("/"). Otherwise, the backslash ("\") should be used... — FaneDuru, May 17 '22 at 14:01
Yes, I did it. but can't use the code. No, I'm not using a Mac. — Siriwan Polpangkwa, May 18 '22 at 07:33

FaneDuru · Accepted Answer · 2022-05-18T07:55:31.160

2

Please, try the next function. It uses an array built from 1 to maximum necessary/existing number. It returns the RND array element and then eliminate it from the array, next time returning from the remained elements:

Please, copy the next variables on top of the module keeping the code you use (in the declarations area):

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

Copy the next function code in the same module:

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

The used array is reset when reaches its limit and send a message.

It may be tested using the next testing Sub:

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

In order to test it faster, you may modify maxNo at 20...

After testing it, you have to modify your code in the next way:

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

Please, test it and send some feedback. I did not test it in Access, but it should work...

edited May 18 '22 at 07:55

answered May 17 '22 at 13:37

FaneDuru

38,298
4
19
27

Thank you for your answer, I have tested it and found that every time I press it, it always shows the same image, both images are named "0". what shoud I do ? – Siriwan Polpangkwa May 18 '22 at 07:28
1

@Siriwan Polpangkwa Did you try playing with `testReturnUniqueRndNo`, as recommended? If yes, what does it return (in Immediate Window) at each click? Is it ever returning the same number? It, practically **cannot return "0"**. It should return between 1 and `maxNo`. If not, please play with it and come back with some feedback, **after that**. I mean, I need to understand if the **function itself has a problem in your installation**, which looks to me very improbable, or the code trying to bring images is problematic... – FaneDuru May 18 '22 at 07:48
1

@Siriwan Polpangkwa If you have AnyDesk or TeamViewer installed and accept a connection, I have some minutes and I will see what happens in your installation... – FaneDuru May 18 '22 at 07:51
1

@Siriwan Polpangkwa Please, test the updated function. I used to play with more versions and copied the last version content without changing `ReturnUniqueRndAccess` with `ReturnUniqueRndNo` (in two places). I tested it in Outlook and **it works as it should**... I am only asking myself why you did not receive any error using the function. Please, place `Option Explicit` on (very) top of the used module... It will oblige you to declare all variables and will warn in cased of using a not declared one. – FaneDuru May 18 '22 at 07:57
Yes, I pressed play "testReturnUniqueRndNo" and after pressing the button it came up like "RandomImage". – Siriwan Polpangkwa May 18 '22 at 10:47
1

@Siriwan Polpangkwa What? Do you mean that it returns "RandomImage" in `Immediate Window` (`Ctrl + G`, being in VBE)? It should return two number (from 1 to `maxNo`)... I will try connected now. After connection, please delete the above comment. I was supposing that you will send that by mail... – FaneDuru May 18 '22 at 10:54
@Siriwan Polpangkwa Please, do not forget to delete the above comment! – FaneDuru May 18 '22 at 11:22
1

Thank you very much. It's very helpful. (❁´◡`❁)(●'◡'●) – Siriwan Polpangkwa May 18 '22 at 11:24
@FaneDura One Quistion If I want to set it at the end of the game Let the person who gets the most points say "congratulations". What should I do? There are 4 players. – Siriwan Polpangkwa May 18 '22 at 11:49
@Siriwan Polpangkwa I am afraid, I cannot get you... What are you talking about? Do you use the pictures in discussion in a game played by 4 players? If so, in order to determine the best player, you should be able to determine the end of the game, read the place where the score is kept, choose the maximum and send a message (`MsgBox`) using the correspondent player name. If not, please better describe what you need. – FaneDuru May 18 '22 at 12:18
I wrote a description of the images in this drive. ↓　https://drive.google.com/drive/folders/1njHkRQ5FpdnjG101KLAn8cntPoFWxX1Z?usp=sharing – Siriwan Polpangkwa May 18 '22 at 12:35
@Siriwan Polpangkwa I am afraid that I still cannot get you. I told you in my previous comment what is to be done. 1. Should I understand that instead of the message sent now by the function, you need one mentioning the winner name? 2. If so, how could I know what are the objects keeping the 4 scores? I told you "read the place where the score is kept", "choose the maximum" and send a message "using the correspondent player name". Who else, then you, could know the objects where the score is kept, correspondent user name for that specific object (text box, label etc.)? – FaneDuru May 18 '22 at 12:52
I find it quite difficult to understand. but i will try 1. No, I don't want to name the winner. 2. The object that retains all 4 points is named "Counter1","Counter2""Counter3"and "Counter4". correspondent player name "P1" "P2" "P3" and "P4" – Siriwan Polpangkwa May 18 '22 at 13:24
@Siriwan And what is that `Object`? A textbox? A label, or what. Depending on this aspect you can know how to read their value. Now, the message is sent inside the function and the function can be adapted that in be moment of consuming all existing numbers to extract the maximum from the four `objects` and send a message, something like "P2 is the winner with x points!" (maximum from `Counter2`)... – FaneDuru May 18 '22 at 13:51
@FuneDuru Counter1-4 and P1-4 is a textbox. – Siriwan Polpangkwa May 18 '22 at 14:15
@Siriwan Polpangkwa I left my office yesterday and did not open my laptop at home. For your case, the function must be updated a little, to make `True` a `Public` `Boolean` variable instead of sending a message. Then, this variable is checked in your code which inserts pictures and if `True` make the evaluation and send the appropriate message. If not clear enough what I say, please place a new question, post there the function code (otherwise, you risk to have the question deleted) and ask about your need. If you tag me (here) I will try helping... – FaneDuru May 19 '22 at 08:20
@Siriwan Polpangkwa I am a little busy today and that's why I asked for placing a new question. If I will not be available, maybe somebody else will solve the issue. If not, I have in mind a solution for your problem, I think... I do not have any environment to test it and no time to build something appropriate. – FaneDuru May 19 '22 at 09:47
Thank you very much for your advice. I have successfully created the sub now. – Siriwan Polpangkwa May 19 '22 at 16:01

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

1 Answers1