PDA

View Full Version : [SOLVED] random unique images

petroj02
09-30-2016, 05:23 AM
Hello everyone,
I am looking for help.... I would like to generate automaticly 15 random and unique Pictures for Image...
so far I have this code, It can eveń overwrite some Images but not the one which was correct before the wrong one... I feel i Need Little push up...

Private Sub CommandButton1_Click()
Dim x As Integer
Dim counter As Integer
Dim priznak(1 To 15) As Integer
counter = 1
Randomize
x = Int(15 * Rnd) + 1
For i = 1 To 15
If i = 1 Then
Me("Image" & i).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & x & ".jpg")
Me("Image" & i).Tag = x
priznak(i) = x
ElseIf i > 1 Then
Me("Image" & i).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & x & ".jpg")
Me("Image" & i).Tag = x
priznak(i) = x
For j = 1 To i - 1
If priznak(j) = priznak(i) Then
End If
Do While priznak(j) = priznak(i)
x = Int(15 * Rnd) + 1
Me("Image" & i).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & x & ".jpg")
Me("Image" & i).Tag = x
priznak(i) = x
Loop
Next
End If
x = Int(15 * Rnd) + 1
Next
End Sub

everyones help would be welcome

snb
09-30-2016, 05:44 AM
series of 15 random unique numbers

sub M_snb()
[A1:A15]="=rand()"
sn=[index(rank(A1:A15,A1:A15),)]
end sub

Kenneth Hobs
09-30-2016, 06:23 AM
I don't know what

correct before the wrong onemeans.

Maybe:

Sub test_RndIntPick()
Dim a() As Variant, i As Integer

a() = RndIntPick(1, 15, 15)
'MsgBox Join(a(), vbLf)
For i = 1 To UBound(a)
Me("Image" & i).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & a(i) & ".jpg")
'MsgBox a(i)
Next i
End Sub

Function RndIntPick(first As Long, last As Long, _
noPick As Long, Optional bSort As Boolean = False) As Variant
Dim i As Long, R As Long, temp As Long, k As Long
ReDim iArr(first To last) As Variant
Dim a() As Variant

For i = first To last
iArr(i) = i
Next i

Randomize
For i = 1 To noPick
R = Int(Rnd() * (last - first + 1 - (i - 1))) + (first + (i - 1))
temp = iArr(R)
iArr(R) = iArr(first + i - 1)
iArr(first + i - 1) = temp
Next i

ReDim Preserve iArr(first To first + noPick - 1)
ReDim a(1 To noPick)
For R = 1 To noPick
a(R) = iArr(LBound(iArr) + R - 1)
Next R

If bSort = True Then
RndIntPick = ArrayListSort(a())
Else
RndIntPick = a()
End If
End Function

Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
With CreateObject("System.Collections.ArrayList")
Dim cl As Variant
For Each cl In sn
Next

.Sort 'Sort ascendending
If bAscending = False Then .Reverse 'Sort and then Reverse to sort descending
ArrayListSort = .toarray()
End With
End Function

petroj02
10-02-2016, 04:34 AM
Snb I think i have made bad description of my Problem, I have 15 Pictures and I want to merge this 15 Pictures to 15 Images randomly and each Picture should be shown only once...( at future it would be Memory game with 15 pairs of Cards, and I will find this pairs...) so your solution is exactly what I described before, but I wanted something different anyway thank you for your Response....

Kenneth I have found my own solution by adding one for each Loop, if you are interested there is solution, which I hope is one of the correct Solutions ...

Dim x As Integer
Dim counter As Integer
Dim priznak(1 To 15) As Integer
counter = 1
Randomize
x = Int(15 * Rnd) + 1
For i = 1 To 15
If i = 1 Then
Me("Image" & i).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & x & ".jpg") 'add first random picture to first image
Me("Image" & i).Tag = x
priznak(i) = x
ElseIf i > 1 Then
Me("Image" & i).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & x & ".jpg") 'add random picture to next images
Me("Image" & i).Tag = x
priznak(i) = x
For Each cell In priznak
For j = 1 To i - 1
Do While priznak(j) = priznak(i)
x = Int(15 * Rnd) + 1
Me("Image" & i).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & x & ".jpg")
Me("Image" & i).Tag = x
priznak(i) = x
Loop
Next
Next
End If
x = Int(15 * Rnd) + 1
Next

snb
10-02-2016, 09:20 AM
Just use:

Sub M_snb()
[A1:A15]="=rand()"
sn=[index(rank(A1:A15,A1:A15),)]

for j=1 to 15
Me("Image" & j).Picture = LoadPicture("V:\CGC_DATA\Images\picture" & sn(j,1) & ".jpg")
next
End Sub