DonationCoder.com Software > Post New Requests Here

IDEA: VPR, visual people randomizer!

<< < (2/5) > >>

vixay:
since you are already using excel... here's a simple module for it, i've tested it and it works well enough.

just put your active cell within your table and run the macro StartRandomizer()


--- ---'Module by Vixay for DonationCoder
Option Explicit
'API for windows sleep
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub StartRandomizer()
'Moves a shape along the cells, and changes color of the final cell
' No exclusivity for now
'30 ms = fast
'100 ms = slow
'150 ms = stop
Dim shpActive As Shape
Dim rCell As Range
Dim lSpeed As Long
Dim lSpeedMax As Long
Dim lWinner As Long
Dim lCount As Long

lSpeed = 30
lSpeedMax = 150
Randomize
lWinner = SelectWinner()
Debug.Print "to be winner:" & lWinner
'get the shape we will use ( must exist or will cause an error )
If ActiveSheet.Shapes.Count > 1 Then
    Set shpActive = ActiveSheet.Shapes(1)
Else
    Set shpActive = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 10, 10, 10, 10)
    shpActive.Fill.Transparency = 0.8
End If

For lSpeed = 30 To lSpeedMax Step 20
    lCount = 0
    For Each rCell In ListArea.Cells
        lCount = lCount + 1
        AlignShapeTo shpActive, rCell
        'Debug.Print rCell.Address
        DoEvents
        'Application.ScreenUpdating = True
        Sleep lSpeed
        'slow down speed randomly with a low probability
        ' i.e. continue through all cells most of the time at the current speed
        ' except no random slowdowns on the last stage
        If Rnd >= 0.95 And lSpeed < 130 Then
        'can tweak the number here to change how often we randomly switch speeds
            lSpeed = lSpeed + 20
            Debug.Print "random speed slowdown:" & lSpeed
        End If
        'if at winner cell, and at final slowdown stage
        If lSpeed >= lSpeedMax And lCount = lWinner Then
            Debug.Print "Found our winner"
            rCell.Interior.Color = vbRed
            Exit For 'stop here
        End If
        'Debug.Print lSpeed
    Next rCell
    Debug.Print "next slowdown:" & lSpeed
Next lSpeed

End Sub

Sub AlignShapeTo(ByRef shpObj As Shape, rCell As Range)
shpObj.Top = rCell.Top
shpObj.Left = rCell.Left
shpObj.Height = rCell.Height
shpObj.Width = rCell.Width
End Sub

Function ListArea() As Range
'Change this function to suit your needs or just make sure your
' active cell is within your table range
Set ListArea = ActiveCell.CurrentRegion
'Set ListArea = Selection
End Function

Function SelectWinner() As Long
'Randomly choose a cell amongst all the cells
Dim lCellCount As Long
lCellCount = ListArea.Count
Randomize
SelectWinner = Rnd * lCellCount + 1
Debug.Print SelectWinner & " / " & lCellCount
End Function

Sub ClearBackgrounds()
ActiveCell.CurrentRegion.Interior.ColorIndex = xlColorIndexNone
End Sub

Let me know what you think.
Should be easy for you to customize colors and all.

Chessnia:
Er... wow, thanks a lot for your time.  :Thmbsup:

I don't have excel. I only use  Open office. Would it work for open office also?

But still, I'm not sure I'm looking for an excel macro, it seems to me that I want to be able to add different features which would be impossible to add to a macro:

run the program in a tiny window,
add features like the gmail thing (you click and you get a star),
getting the coloured cell to move around till it stops on one name on the list and the ability to make sure that that name is not repeated again, 
Perhaps add sound to the next version
etc.

In other words, I think I need a stand alone program.

vixay:
sorry, my bad. I assumed the screenshot was excel. No as far as i know it shouldn't  work in openoffice, but hmm that gives me an opportunity to try macros in open office :)
As for stand alone... I don't have enough time for that, though I do have one flash application lying about which did something similar. I'll see if i can find it.

steeladept:
May be opening a can of worms here, but if you don't use the screen at that time for anything else (like showing a question to the class, for example), maybe you could take the kid's picture and have it rotate through the pictures?  The program logic would be the same, just the data would show up differently (like flipping through a photo album at high speed looping through and stopping at a random picture).  Just a thought if you are making it "visual".

scancode:
May be opening a can of worms here, but if you don't use the screen at that time for anything else (like showing a question to the class, for example), maybe you could take the kid's picture and have it rotate through the pictures?  The program logic would be the same, just the data would show up differently (like flipping through a photo album at high speed looping through and stopping at a random picture).  Just a thought if you are making it "visual".
-steeladept (July 02, 2010, 10:26 AM)
--- End quote ---

When I first heard about this snack, I thought about something like this.

Navigation

[0] Message Index

[#] Next page

[*] Previous page