Stuff that makes me smile

Monday, 4 January 2010

Giving MS Word Touretts and pissing your colleagues off!

Bored in the office? Try these!


Top 10 Computer and Office Related Pranks To Do on April Fools

Find the original here!


'---------------------------- START OF TOURETTES --------------------------
'
' Microsoft Word Tourettes v2.0
' Originally Discovered On
' *** http://www.iambetterthanu.com ***
'
'
' To add colour, font size and rotation random goodness, change the lines
'
' FontChange = False
' to
' FontChange = True
'
' ColourChange = False
' to
' ColourChange = True
'
' depending on what you want to happen. Enjoy!!!
'
' DelaySecs The max pause time between 'incidents'
' MaxFontSize The largest pointsize to use for fonts
'
'--------------------------------------------------------------------------
Dim TourettesList() As Variant
Dim GotTourettesList As Boolean
Dim FontList() As Variant
Dim FontChange As Boolean
Dim ColourChange As Boolean
Dim TourCount As Integer
Dim FontCount As Integer
Dim DelaySecs As Integer
Dim MaxFontSize As Integer
Dim NewColour As String
Dim fonty As String

Sub AutoExec()
Randomize
' Change these to enable random fonts, colours and rotation
FontChange = True
ColourChange = True
DelaySecs = 30
MaxFontSize = 120
GetFontList
FontCount = UBound(FontList)
GetTourettesList
TourCount = UBound(TourettesList)
Call typeRand
End Sub
Sub typeRand()
Dim counter As String
counter = CStr(Int((DelaySecs) * Rnd + 1))
Application.OnTime When:=Now + TimeValue("00:00:" + counter), _
Name:="TimedClose"
End Sub
Public Sub TimedClose()
Dim maindocument As Document
Set maindocument = ActiveDocument
counter = CStr(Int((TourCount) * Rnd + 1))
fonty = CStr(Int((FontCount) * Rnd + 1))
curse = TourettesList(counter)
With Selection
If FontChange = True Then
.Font.Size = CStr(Int((MaxFontSize - 10) * Rnd + 10))
.Font.Name = FontList(fonty)
End If
If ColourChange = True Then
.Font.Color = RGB((Int(255) * Rnd), (Int(255) * Rnd), (Int(255) * Rnd))
End If
.TypeText " " + curse + " "
End With
Call typeRand
End Sub
Sub ShowInstalledFonts()
If FontsChecked = False Then
Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)
' If Font control is missing, create a temp CommandBar
If FontList Is Nothing Then
Set TempBar = Application.CommandBars.Add
Set FontList = TempBar.Controls.Add(ID:=1728)
End If
' Put the fonts into column A
Range("A:A").ClearContents
For i = 0 To FontList.ListCount - 1
Cells(i + 1, 1) = FontList.List(i + 1)
Next i
' Delete temp CommandBar if it exists
On Error Resume Next
TempBar.Delete
FontsChecked = True
End If
End Sub
Sub GetTourettesList()
' If you wish to add more to this, do it above the last entry
' and make sure your line has quote marks on either side, with a comma
' then a line break.
TourettesList = Array("SHIT", "PISS", "CUNT", "COCKSUCKER", _
"COCK", "PUSSY", "BASTARD", "FUCK", _
"DOBBER", "MONG", "ASSHOLE", "BITCH", _
"MOTHERFUCKER", "ASSHAT", "DILDO", "SHITHEAD", _
"BELLEND", "KNOB", "DICKHEAD", "FUCKNUCKLE", _
"VAGINA", "CUNTLIP", "RINGPIECE", "NUTSACK", _
"SCROTE FACE", "BALLBAG")
End Sub
Sub GetFontList()
' No need to edit anything below, as most default fonts are shown.
FontList = Array("Agency FB", "Agency FB Bold", "Algerian", "Arial", "Arial Black", "Arial Black Italic", "Arial Bold", "Arial Italic", "Arial Narrow", "Arial Narrow Bold", "Arial Narrow Italic", _
"Arial Rounded MT Bold", "Arial Unicode MS", "Baskerville Old Face", "Batang", "Bauhaus 93", "Bell MT", "Bell MT Bold", "Bell MT Italic", "Berlin Sans FB", "Berlin Sans FB Bold", "Berlin Sans FB Demi Bold", "Bernard MT Condensed", "Blackadder ITC", "Bodoni MT", "Bodoni MT Black", _
"Bodoni MT Black Italic", "Bodoni MT Bold", "Bodoni MT Bold Italic", "Bodoni MT Condensed", "Bodoni MT Condensed Bold", "Bodoni MT Condensed Bold Italic", "Bodoni MT Condensed Italic", "Bodoni MT Italic", "Bodoni MT Poster Compressed", "Book Antiqua", _
"Book Antiqua Bold", "Book Antiqua Bold Italic", "Book Antiqua Italic", "Bookman Old Style", "Bookman Old Style Bold", "Bookman Old Style Bold Italic", "Bookman Old Style Italic", "Bradley Hand ITC", "Britannic Bold", "Broadway", "Brush Script MT Italic", _
"Californian FB", "Californian FB Bold", "Californian FB Italic", "Calisto MT", "Calisto MT Bold", "Calisto MT Bold Italic", "Calisto MT Italic", "Castellar", "Centaur", "Century", "Century Gothic", "Century Gothic Bold", "Century Gothic Bold Italic", _
"Century Gothic Italic", "Century Schoolbook", "Century Schoolbook Bold", "Century Schoolbook Bold Italic", "Century Schoolbook Italic", "Chiller", "Colonna MT", "Comic Sans MS", "Comic Sans MS Bold", "Cooper Black", "Copperplate Gothic Bold", "Copperplate Gothic Light", _
"Courier New", "Courier New Bold", "Courier New Bold Italic", "Courier New Italic", "Curlz MT", "Edwardian Script ITC", "Elephant", "Elephant Italic", "Engravers MT", "Eras Bold ITC", "Eras Demi ITC", "Eras Light ITC", "Eras Medium ITC", "Estrangelo Edessa", _
"Felix Titling", "Footlight MT Light", "Forte", "Franklin Gothic Book", "Franklin Gothic Book Italic", "Franklin Gothic Demi", "Franklin Gothic Demi Cond", "Franklin Gothic Demi Italic", "Franklin Gothic Heavy", "Franklin Gothic Heavy Italic", _
"Franklin Gothic Medium", "Franklin Gothic Medium Cond", "Franklin Gothic Medium Italic", "Freestyle Script", "French Script MT", "Garamond", "Garamond Bold", "Garamond Italic", "Gigi", "Gill Sans MT", "Gill Sans MT Bold", "Gill Sans MT Condensed", _
"Gill Sans MT Ext Condensed Bold", "Gill Sans MT Italic", "Gill Sans Ultra Bold", "Gill Sans Ultra Bold Condensed", "Gloucester MT Extra Condensed", "Goudy Old Style", "Goudy Old Style Bold", "Goudy Old Style Italic", "Goudy Stout", "Haettenschweiler", _
"Harlow Solid Italic", "Harrington", "High Tower Text", "High Tower Text Italic", "Impact", "Imprint MT Shadow", "Informal Roman", "Jokerman", "Juice ITC", "Kristen ITC", "Kunstler Script", "Latha", "Lucida Bright", "Lucida Bright Demibold", "Lucida Bright Demibold Italic", _
"Lucida Bright Italic", "Lucida Calligraphy Italic", "Lucida Fax Demibold", "Lucida Fax Italic", "Lucida Fax Regular", "Lucida Handwriting Italic", "Lucida Sans Demibold Roman", "Lucida Sans Italic", "Lucida Sans Regular", "Lucida Sans Typewriter Bold", "Lucida Sans Typewriter Bold Oblique", "Lucida Sans Typewriter Oblique", _
"Lucida Sans Typewriter Regular", "Magneto Bold", "Maiandra GD", "Mangal", "MapSymbols", "Matura MT Script Capitals", "Mistral", "Modern No. 20", "Monotype Corsiva", "MS Mincho", "MS Outlook", "MT Extra", "Niagara Engraved", "Niagara Solid", "OCR A Extended", _
"Old English Text MT", "Onyx", "Palace Script MT", "Papyrus", "Parchment", "Perpetua", "Perpetua Bold", "Perpetua Bold Italic", "Perpetua Italic", "Perpetua Titling MT Bold", "Perpetua Titling MT Light", "Playbill", "PMingLiU", "Poor Richard", "Pristina", _
"Rage Italic", "Ravie", "Rockwell", "Rockwell Bold", "Rockwell Bold Italic", "Rockwell Condensed", "Rockwell Condensed Bold", "Rockwell Extra Bold", "Rockwell Italic", "Script MT Bold", "Showcard Gothic", "SimSun", "Snap ITC", "Stencil", "Sylfaen", "Symbol", "Tahoma", _
"Tahoma Bold", "Tempus Sans ITC", "Times New Roman", "Times New Roman Bold", "Times New Roman Bold Italic", "Times New Roman Italic", "Trebuchet MS", "Trebuchet MS Bold", "Trebuchet MS Bold Italic", "Trebuchet MS Italic", "Tw Cen MT", "Tw Cen MT Bold", _
"Tw Cen MT Bold Italic", "Tw Cen MT Condensed", "Tw Cen MT Condensed Bold", "Tw Cen MT Condensed Extra Bold", "Tw Cen MT Italic", "Verdana", "Verdana Bold", "Verdana Bold Italic", "Verdana Italic", "Viner Hand ITC", "VisualUI", "Vivaldi Italic", "Vladimir Script", "Wide Latin")
End Sub
'----------------------------- END OF TOURETTES ---------------------------

0 comments :

Post a Comment

Thank you for taking the time to comment. Your opinion is important and of value and we appreciate the positive feedback! If you are "Negative Nancy" then please do us, and humanity, a favor, and piss off.

Total Pageviews

Google+ Followers

Pages

Blog Archive

Popular Posts

Recent Comments

Rays Twitter feed

Ads

Web sites come and go and information is lost and therefore some pages are archived. @rayd123 . Powered by Blogger.