用電腦「抽籤」這檔事，我嘗試過許多種不同的方法有非常多的方法。除了用
Flash來做抽籤以外，我還試過
用EXCEL、
網頁(HTML+Javascript)來抽籤，甚至我還
手工打造過一台八路搶答器來玩，可見我對這檔事有多認真了。
抽籤要有趣，一定要有聲光效果，像我之前做的那個搶答器就很讚，還有以前做的Flash抽籤也很棒，因為我直接把大頭照放進去跑抽籤，所以出現的畫面都是學生的大頭。
每學年的第一堂課，我都會幫學生拍大頭照，除了自己留著可以在未來指認學生外，另外像做
光合照片或是大頭照抽籤也很好用。
我以前曾經在演講時秀過我做的大頭照抽籤的flash檔案，後來陸續有老師來向我索取原始檔製作。不過坦白說，要做flash，對許多人來說，還是有入門的障礙。終於，我來幫大家突破障礙了，我又做了一個抽籤檔案，這可是用PowerPoint+VBA寫的呢。
你要做的只要「新增投影片」，然後插入圖片或是文字就行了。進入播放模式後，按鈕的位置就在沒被圖片遮住的地方，按下去之後，就會開始亂數跳頁，不只如此，你還可以配合PowerPoint的換頁聲音，幫它加上抽籤的音效呢！
接下來，來介紹詳細點
下載之後，開啟。你應該可以看到下面這個
安全性警告，請允許
啟用巨集
如果沒出現上面那個畫面，請到
工具/選項裡去把
安全性調低一點，然後關掉再開一次，直到出現上面那個啟用巨集的畫面。
到這邊之後，你只要
新增投影片，把你要拿來抽籤的東西放在裡頭就行了。例如你打算抽1~40號的同學號碼，那就在第1張投影片寫1，第二張寫2，以此類推。或者你如果要抽大頭照，那也是一樣的道理，只要在每張投影片放一張照片就行了。
說到放大頭照，這個檔案做出來的目的就是要做「大頭照抽籤」的啊！我一定要讓它更方便使用，所以我加了一些程式碼，讓放照片只要幾個步驟就通通完成。
=====2009.07.12新增修改===================其實根本不用另外寫程式，直接用內建的功能就可以插入照片到每一張投影片就是這個插入/圖片/新相簿請見
用PowerPoint玩大頭照抽籤(3)(本文以下的部分可以忽略了)
=======================================
如果你要用程式碼來幫你加照片，你必須先做好以下的幾件事
- 在C槽裡，新增一個pic資料夾，然後把照片都丟到裡面。
- 這些照片的檔案一定要是1.jpg、2.jpg，以此類推，中間不能空號
- 如果你有30張照片，就先新增好30張空白投影片
接著就用程式碼來幫我們加照片，
開啟巨集
選
front這個巨集，按下執行。這個巨集的功能是幫你把C槽的pic資料夾裡的照片插入到投影片裡，如果是選
back，那就是把圖片填入背景。
看你喜歡讓圖片變成背景或是在前景都可以，不過兩者最大的差別是，如果放在背景，那整個畫面都可以當按鈕，但如果是放在前景，那就只有非圖片的地方是按鈕。(底下圖片是之前截圖的，巨集名稱還沒改掉，所以看起來跟各位下載的不太一樣。)
有時候會出現這個對話方塊，按下
結束之後，再回到上一步
重新執行一次巨集就可以了。
(出現這個對話方塊之後，第一張投影片會出現2張照片，最後再刪掉一張就可以了，這是我還不會解決的bug)
簡單幾步驟就完成了這個抽籤檔案啦。
有些地方你可以自己再做修改，例如抽籤時候出現的聲音，你可以到【
投影片切換】的地方去改聲音，最後記得按下【
套用至所有投影片】
程式碼的部份，如果你看得懂，就自己改吧。我的按鈕是放在母片上面，是一個
透明度百分之百的大方塊，所以不管跳到哪一頁，按鈕都還是能夠執行。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub lottery()
Dim p As Integer
Dim page As Integer
p = 1
While p <= 6
Sleep 10 '停留幾毫秒
DoEvents
page = Int(Application.ActivePresentation.Slides.Count * Rnd) + 1
SlideShowWindows(1).View.GotoSlide page
p = p + 1
Wend
End Sub
Sub back()
Dim i As Integer
For i = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Select
With ActiveWindow.Selection.SlideRange
.FollowMasterBackground = msoFalse
.Background.Fill.UserPicture "C:\pic\" & i & ".jpg"
End With
Next
End Sub
Sub front()
Dim i As Integer
Dim name As String
For i = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Select
name = "C:\pic\" & i & ".jpg"
With ActiveWindow.Selection.SlideRange
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=name, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=309, Top:=231).Select
ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With
Next
End Sub
