The annoying in-the-stream ads

[erik.van.geit]

I always wondered what those two little strings dangling from your nose were...

you guys inspired me

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub bleeding_nose()
'Erik Van Geit
'061107
Dim AWVRH As Integer
Dim AWVRW As Integer

Dim Sh As Shape
Dim TP As Double
Dim LP As Double
Dim ShH As Integer
Dim ShW As Integer
Dim ShClear As Shape

Dim WB As Workbook
Dim NoHarm As Boolean

Dim i As Integer

'if NoHarm is True then pressing escape will "undo" the macro
'if NoHarm is False you should stay in the neighbourhood ! :-)
NoHarm = True

    If NoHarm Then
    Application.ScreenUpdating = False
    ActiveSheet.Copy
    Set WB = ActiveWorkbook
    Application.ScreenUpdating = True
    Else
    'if any problems, you can find this file in same directory
    Set WB = ActiveWorkbook
    WB.SaveCopyAs Left(WB.FullName, Len(WB.FullName) - 4) & " no bled.xls"
    End If

Application.EnableCancelKey = xlErrorHandler
On Error GoTo StopBleeding

AWVRH = ActiveWindow.VisibleRange.Height * 0.95
AWVRW = ActiveWindow.VisibleRange.Width * 0.95

    Do
    Randomize Timer
    LP = Rnd * AWVRW + AWVRW * 0.025
    TP = Rnd * AWVRH + AWVRH * 0.025
    ShH = 4 * Rnd + 5
    ShW = 4 * Rnd + 5
    
        With WB.ActiveSheet.Shapes
            Select Case Rnd
            Case 0 To 0.6
            Set Sh = .AddShape(msoShapeExplosion1, LP, TP, ShW, ShH)
            Case 0.6 To 0.8
            Set Sh = .AddShape(msoShapeExplosion2, LP, TP, ShW, ShH)
            Case Else
            Set Sh = .AddShape(msoShapeSun, LP, TP, ShW, ShH)
            End Select
        End With
        
        With Sh
        .Fill.ForeColor.SchemeColor = 10
        .Fill.Transparency = Rnd * 0.8
        .Line.Visible = msoFalse
        If NoHarm = False Then .OnAction = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".xls!oh"
        End With
    
        For i = 1 To Int(Rnd * 10)
        Sleep CLng(Rnd * 99)
        DoEvents
        Next i

        For Each ShClear In ActiveSheet.Shapes
        If Not Intersect(Selection, ShClear.TopLeftCell) Is Nothing Then ShClear.Delete
        Next ShClear
    Loop

StopBleeding:
Err.Clear
Application.EnableCancelKey = xlDisabled
    If NoHarm Then
    WB.Close False
    Else
    'automatisation error if user closed WB "while bleeding"
    'same error checking if WB is still open
    'On Error Resume Next didn't work
    'not a big issue anyway :-)
        With WB.ActiveSheet.Buttons.Add(25, 25, 200, 80)
        .OnAction = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".xls!oh"
        .Characters.Text = "A fatal problem occured: " & vbLf & "Your system has solved this only partially. Please click the shapes and this button to remove them."
        End With
    End If

End Sub

Sub oh()
ActiveSheet.Shapes(Application.Caller).Delete
End Sub

Private Sub Workbook_Open()
'set the delay to run the code
Application.OnTime Now + TimeValue("00:03:00"), "bleeding_nose"
End Sub

 

[Richard Schollar]

Erik

Now that is class! I can see me having some fun with this at work

 

[erik.van.geit]

thanks
I would like you to tell us the story when done

 

[Oorang]

That is so wrong I need a "flow" chart to explain it.

 

[erik.van.geit]

That is so wrong I need a "flow" chart to explain it.

and my dictionnary couldn't help to understand this oneliner

 

[Greg Truby]

"Hi, hon. Yeah, I stopped by the store after my workout. Do we need anything? Uh huh, milk, bread and....Geez, yeah, ok, I know better than to say "no". But you have to agree to no getting mad if I get brand right. Size, capacity, scent, shape -- you get what you get -- I ain't spending thirty minutes standing in front of all six thousand varieties trying to find just the right box."

So, yeah, you could say I've got no problem with a website that would mean I never have that conversation again...

And is it just me, or does anyone else find their "about us" page extremely ironic -- the word "discrete" is in big, bold letters, and right below is a pic of the FedEx guy handing off the box. Or are we to assume that the return address label does not give away the contents of the shipment?

And Erik, very, very funny!

 

[Greg Truby]

Uh, the code was funny.

As for Aaron's quip. C'mon use your imagination...assuming you know what a "flow chart" is. "Flow" is also another term occasionally used to refer to - you know. For example, one slang way of saying it's "that time of the month" is to say "Aunt Flo is visiting".

 

[Von Pookie]

Yeaaaaaaah...could we get off of this particular subject, please? Not that it's really crossing the line or anything, but I really don't want to read about it--let alone *here*.

 

[Greg Truby]

LOL. I kept wondering at what point we were finally going to get you or Tracy to groan and say "enough, boys, enough". But ya gotta admit the entire concept seems more like a script for a MAD TV skit or something.

So -- to change the subject -- love the new avatar!

 

[Von Pookie]

Honestly, I'm surprised it went on that long *without* intervention of some sort. Not like you guys have first-hand knowledge or anything.

Anyway. Avatar. YES. That. I had to save it as a jpg to get the file size down (just 1k over in the original gif form, grr), but there it is.

I made that, actually. I really made it for one of my friends to use on livejournal (I was bored that night), but I figure hey, I made it, I can do what I want. I have a version in blue, as well.