2008年12月24日

用PowerPoint玩大頭照抽籤

用電腦「抽籤」這檔事,我嘗試過許多種不同的方法有非常多的方法。除了用Flash來做抽籤以外,我還試過用EXCEL網頁(HTML+Javascript)來抽籤,甚至我還手工打造過一台八路搶答器來玩,可見我對這檔事有多認真了。

抽籤要有趣,一定要有聲光效果,像我之前做的那個搶答器就很讚,還有以前做的Flash抽籤也很棒,因為我直接把大頭照放進去跑抽籤,所以出現的畫面都是學生的大頭。

每學年的第一堂課,我都會幫學生拍大頭照,除了自己留著可以在未來指認學生外,另外像做光合照片或是大頭照抽籤也很好用。

我以前曾經在演講時秀過我做的大頭照抽籤的flash檔案,後來陸續有老師來向我索取原始檔製作。不過坦白說,要做flash,對許多人來說,還是有入門的障礙。終於,我來幫大家突破障礙了,我又做了一個抽籤檔案,這可是用PowerPoint+VBA寫的呢。

你要做的只要「新增投影片」,然後插入圖片或是文字就行了。進入播放模式後,按鈕的位置就在沒被圖片遮住的地方,按下去之後,就會開始亂數跳頁,不只如此,你還可以配合PowerPoint的換頁聲音,幫它加上抽籤的音效呢!




接下來,來介紹詳細點

下載之後,開啟。你應該可以看到下面這個安全性警告,請允許啟用巨集




如果沒出現上面那個畫面,請到工具/選項裡去把安全性調低一點,然後關掉再開一次,直到出現上面那個啟用巨集的畫面。



到這邊之後,你只要新增投影片,把你要拿來抽籤的東西放在裡頭就行了。例如你打算抽1~40號的同學號碼,那就在第1張投影片寫1,第二張寫2,以此類推。或者你如果要抽大頭照,那也是一樣的道理,只要在每張投影片放一張照片就行了。

說到放大頭照,這個檔案做出來的目的就是要做「大頭照抽籤」的啊!我一定要讓它更方便使用,所以我加了一些程式碼,讓放照片只要幾個步驟就通通完成。

=====2009.07.12新增修改===================
其實根本不用另外寫程式,直接用內建的功能就可以插入照片到每一張投影片
就是這個插入/圖片/新相簿

請見用PowerPoint玩大頭照抽籤(3)
(本文以下的部分可以忽略了)
=======================================



如果你要用程式碼來幫你加照片,你必須先做好以下的幾件事
  1. 在C槽裡,新增一個pic資料夾,然後把照片都丟到裡面。
  2. 這些照片的檔案一定要是1.jpg、2.jpg,以此類推,中間不能空號
  3. 如果你有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