ASKER
randomly display a student's picture and name...?
Also would like to use a time and run through about 10 pictures before the students see the final picture select displayed on the form.The first part of your question needs to be cleared up first...
ASKER
SELECT TOP 1 Rnd([studentID]) AS Expr1, tblStudent.studentClassID, tblStudent.studentPic, tblStudent.studentID
FROM tblStudent
WHERE (((tblStudent.studentClassID)=[Forms]![frmRandom]![studentClassID]));
ASKER
Option Explicit
Public Function UniqueRandomLongs(Minimum As Long, Maximum As Long, _
Number As Long, Optional ArrayBase As Long = 1, _
Optional Dummy As Variant) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' UniqueRandomLongs
' This returns an array containing elements whose values are between the Minimum and
' Maximum parameters. The number of elements in the result array is specified by the
' Number parameter. For example, you can request an array of 20 Longs between 500 and
' 1000 (inclusive).
' There will be no duplicate values in the result array.
'
' The ArrayBase parameter is used to specify the LBound of the ResultArray. If this
' is omitted, ResultArray is 1-based.
'
' The Dummy argument is to be used only when the function is called from a worksheet.
' Its purpose is to allow you to use the NOW() function as the Dummy parameter to force
' Excel to calculate this function any time a calculation is performed. E.g.,
' =UniqueRandomLongs(100,199,10,NOW())
' If you don't want to recalulate this function on every calculation, omit the Dummy
' parameter. The Dummy argument serves no other purpose and is not used anywhere
' in the code.
'
' The function returns an array of Longs if successful or NULL if an error occurred
' (invalid input parameter).
'
' Note: The procedure creates its own array of size (Maximum-Minium+1), so very large
' differences between Minimum and Maximum may cause performace issues.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SourceArr() As Long
Dim ResultArr() As Long
Dim SourceNdx As Long
Dim ResultNdx As Long
Dim TopNdx As Long
Dim Temp As Long
''''''''''''''''''''''''''''''''''''''
' Test the input parameters to ensure
' they are valid.
''''''''''''''''''''''''''''''''''''''
If Minimum > Maximum Then
UniqueRandomLongs = Null
Exit Function
End If
If Number > (Maximum - Minimum + 1) Then
UniqueRandomLongs = Null
Exit Function
End If
If Number <= 0 Then
UniqueRandomLongs = Null
Exit Function
End If
Randomize
''''''''''''''''''''''''''''''''''''''''''''''
' Redim the arrays.
' SourceArr will be sized with an LBound of
' Minimum and a UBound of Maximum, and will
' contain the integers between Minimum and
' Maximum (inclusive). ResultArray gets
' a LBound of ArrayBase and a UBound of
' (ArrayBase+Number-1)
''''''''''''''''''''''''''''''''''''''''''''''
ReDim SourceArr(Minimum To Maximum)
ReDim ResultArr(ArrayBase To (ArrayBase + Number - 1))
''''''''''''''''''''''''''''''''''''''''''''
' Load SourceArr with the integers between
' Minimum and Maximum (inclusive).
''''''''''''''''''''''''''''''''''''''''''''
For SourceNdx = Minimum To Maximum
SourceArr(SourceNdx) = SourceNdx
Next SourceNdx
''''''''''''''''''''''''''''''''''''''''''''''
' TopNdx is the upper limit of the SourceArr
' from which the Longs will be selected. It
' is initialized to UBound(SourceArr), and
' decremented in each iteration of the loop.
' Selections from SourceArr are always in the
' region including and to the left of TopNdx.
' The region above (to the right of) TopNdx
' is where the used numbers are stored and
' no selection is made from that region of
' the array.
''''''''''''''''''''''''''''''''''''''''''''''
TopNdx = UBound(SourceArr)
For ResultNdx = LBound(ResultArr) To UBound(ResultArr)
''''''''''''''''''''''''''''''''''''''''''''''''''
' Set SourceNdx to a random number between 1 and
' TopNdx. ResultArr(ResultNdx) will get its value from
' SourceArr(SourceNdx). Only elements of SourceArr
' in the region of the array below (to the left of)
' TopNdx (inclusive) will be selected for inclusion
' in ResultArr. This ensures that the elements in
' ResultArr are not duplicated.
''''''''''''''''''''''''''''''''''''''''''''''''''
SourceNdx = Int((TopNdx - Minimum + 1) * Rnd + Minimum)
ResultArr(ResultNdx) = SourceArr(SourceNdx)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Now, swap elements SourceNdx and TopNdx of SourceArr,
' moving the value in SourceArr(SourceNdx) to the region
' of SourceArr that is above TopNdx. Since only elements
' of SourceArr in the region below TopNdx (inclusive) are
' possible candidates for inclusion in ResultArr, used
' values are placed at TopNdx to ensure no duplicates.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Temp = SourceArr(SourceNdx)
SourceArr(SourceNdx) = SourceArr(TopNdx)
SourceArr(TopNdx) = Temp
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Decrment TopNdx. This moves the effective UBound of SourceArr
' downwards (to the left), thus removing used numbers from the
' possibility of inclusion in ResultArr. This ensures we have
' no duplicates in the ResultArr.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
TopNdx = TopNdx - 1
Next ResultNdx
''''''''''''''''''''''''''''''
' Return the result array.
''''''''''''''''''''''''''''''
UniqueRandomLongs = ResultArr
End Function
Function IsArrayAllocated(V As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''
' Ensure we have an allocated array.
''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
IsArrayAllocated = Not (IsError(LBound(V)) And IsArray(V)) And (LBound(V) <= UBound(V))
End Function
Private Sub Form_Load()
On Error GoTo Cleanup
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Res As Variant
Dim Min As Long, Max As Long, N As Long
Dim i As Long
Dim dtWaitTime As Date
Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT * FROM tblStudent")
Min = 1
N = 10
If Not (rs.BOF And rs.EOF) Then
rs.MoveLast
rs.MoveFirst
Max = rs.RecordCount
End If
Res = UniqueRandomLongs(Minimum:=Min, Maximum:=Max, Number:=N)
With rs
Do Until .EOF = True
rs.Edit
If i < N Then
If IsArrayAllocated(Res) Then
For N = LBound(Res) To UBound(Res)
' if you have a 'selected' field in the table, it will insure that no student will be selected more than once
' to incorporate it, add a yes/no field to the table and uncomment the following commented lines
' If !selected = False Then
If !studentID = Res(N) Then
' change frmNameofYourForm to the name of your form
DoCmd.GoToRecord ObjectType:=acDataForm, ObjectName:="frmNameofYourForm", Record:=acGoTo, Offset:=!studentID
dtWaitTime = Now + TimeValue("00:00:01")
Do
DoEvents
Loop Until Now >= dtWaitTime
' !selected = True
i = i + 1
Debug.Print Res(N)
End If
' End If
Next N
End If
.Update
.MoveNext
End If
Loop
End With
Cleanup:
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End If
End Sub
ASKER
ASKER
ASKER
Microsoft Access is a rapid application development (RAD) relational database tool. Access can be used for both desktop and web-based applications, and uses VBA (Visual Basic for Applications) as its coding language.
TRUSTED BY