現在的國中生雖然已經在學校很多年，但是要他們抄個聯絡簿還是落東落西，經常重要的訊息不是沒寫到就是寫錯。很多導師只好用小學一二年級的方法，把重要訊息用電腦打字，全班有幾位學生就複製貼上幾個，作成一張列印出來(如下圖)，再請學生裁剪貼在聯絡簿上。
這件工作看起來是小事一件，但是每天如果都要複製貼上二三十次也是有點煩。雖然我不是導師，但是因為我負責升學報名的業務，最近一堆升學相關的重要訊息，要麻煩導師轉知家長學生，為了減輕導師端的負荷，只好我自己來做要貼聯絡簿的資料，作成一張然後複印27份給九年級各班導師。
這種事做兩次就有點煩，就乾脆設計一個WORD巨集範本(範本下載連結)，這個範本的功能很簡單，使用者下載檔案解壓縮之後，只要用滑鼠點範本檔案(聯絡簿範本.dotm)兩下，自動會啟動WORD，並以此範本新增一個WORD檔案，內容如下：
使用者只要依提示在表格的第一格輸入要通知家長的訊息，然後點選[增益集]功能區，會看到[自訂工具列]中會出現[複製訊息]這個按鈕，只要按這個按鈕，範本中的巨集程式自動會將第1格的內容複製貼到其它格子中。
舉例我要通知學生家長模擬選填的起迄時間，我在表格的第一格輸入以下內容
然後點選[增益集]\[自訂工具列]\[複製訊息]，巨集程式自動將訊息複製貼到表格中所有格子(如下)，使用者就不用複製貼上那麼多次。
巨集程式碼如下
'作者:楊煥謀 20140225
Sub t()
Dim i As Long, j As Long
Dim c As Long
Dim r As Long
ActiveDocument.Tables(1).Select
c = ActiveDocument.Tables(1).Columns.Count
r = ActiveDocument.Tables(1).Rows.Count
For i = 1 To c
For j = 1 To r
ActiveDocument.Tables(1).Columns(1).Cells(1).Select
Selection.Copy
ActiveDocument.Tables(1).Columns(i).Cells(j).Select
Selection.Paste
Next j
Next i
End Sub
Sub addmain()
On Error Resume Next
Dim obCommandbar As CommandBar
Dim newItemI1 As CommandBarButton
Set obCommandbar = ActiveDocument.CommandBars.Add(Name:="聯絡簿", Position:=msoBarTop, Temporary:=False)
obCommandbar.Visible = True
Set newItemI1 = obCommandbar.Controls.Add(Type:=msoControlButton, Temporary:=False)
With newItemI1
.Caption = "複製訊息"
.Enabled = True
.BeginGroup = True
.Style = msoButtonWrapCaption
.OnAction = "t"
End With
Set obCommandbar = Nothing
Set newItemI1 = Nothing
End Sub
Sub dc()
On Error Resume Next
ActiveDocument.CommandBars("聯絡簿").Delete
End Sub
注意事項:
1.現在的班級人數大概是30人左右，範本的格子數目為32，版面是B4大小，使用者可以依照需要修改表格的欄列數目，或變更版面大小，但是記得程式只針對文件中第一個表格進行操作。
2.範本是在WORD 2010撰寫，要用於WORD 2003，請開啟範本利用另存新檔的功能儲存範本為2003的範本格式。
十年磨一劍 