excel_vba_编程教程(完整版)-第78部分
按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
的信息将出现在加载宏对话框里面
6。 点击确定以退出属性对话框
7。 选择文件｜另存为并且将该工作簿保存为Calendar。xls
8。 现在，选择文件｜另存为，将Calendar。xls保存为一个加载宏。从另存为类型下拉清单，选
择Microsoft Excel加载宏。输入一 个新名称（CalendarMaker。xla）然后点击保存
9。 关闭Calendar。xls工作簿
10。 打开一个新工作簿
11。 选择工具｜加载宏。使用浏览按钮将CalendarMaker加入到加载宏清单里面。勾选列表框里的
CalendarMaker加载宏。当你点 击确定后，Workbook_AddInInstall过程就会被引发。点击信
息框上的确定
12。 想要创建一个日历的话，可以选择工具｜宏｜宏，在宏名称文本框里输入CalendarMaker然后
点击运行，你将会被询问年和月， 输入年和月（例如，Nov 2005）并点击确定，将出现一日
历页，如图14…5所示
275
… 页面 292…
图14…5 由过程CalendarMaker创建的月历
13。 想要引发示例17中示范的AddInUninstall事件过程的话，可以选择工具｜加载宏，并清除
CalendarMaker加载宏前面的勾选标 志就可以了。
事件名称 卸载加载宏
事件描述 示例17
当用户卸载一个加载宏时，引发 该事件
Private Sub Workbook_AddinUninstall（）
MsgBox 〃The CalendarMaker 〃 & vbCrLf _
& 〃add…in was unloaded。〃
End Sub
一旦该工作簿作为一个加载宏被卸载后，示例程序将显示一个信息
示例17 – 试验：参见示例16
下述过程CalendarMaker可在CodeLibrarian 加载宏里获得，这里用来示范工作簿对象的安装加载
宏和卸载加载宏事件的使用（参 见示例16和17）。
Sub CalendarMaker（）
Dim MyInput As String
Dim StartDay As Date
Dim DayofWeek As Integer； CurYear As Integer； CurMonth As Integer
Dim FinalDay As Long
Dim cell As Range
Dim RowCell As Integer； ColCell As Integer
Dim x As Integer
‘以上变量声明为译者加上的，以确保程序正常运行
' protect sheet if had previous calendar to prevent error。 保护工作表，以避免之前
日历 带来的错误（原文误为Unprotect）
ActiveSheet。Protect DrawingObjects：=False； Contents：=False； _
Scenarios：=False
' Prevent screen flashing while drawing calendar。 制作日历时防止屏幕闪烁
Application。ScreenUpdating = False
' Set up error trapping。 设置错误陷阱
On Error GoTo MyErrorTrap
' Clear area a1：g14 including any previous calendar。 清除a1：g14单元格区域的内容
Range（〃a1：g14〃）。Clear
' Use InputBox to get desired month and year and set variable
' MyInput。 使用输入框从用户获得年月，并赋予变量MyInput
MyInput = InputBox（〃Type in Month and year for Calendar 〃）
' Allow user to end macro with Cancel in InputBox。 允许用户点击取消以终止宏
If MyInput = 〃〃 Then Exit Sub
' Get the date value of the beginning of input month。 获取输入年月的日期序号
StartDay = DateValue（MyInput）
276
… 页面 293…
' Check if valid date but not the first of the month 检查是否是有效日期，但不是当
月第一天
' if so； reset StartDay to first day of month。 如不是，则设置StartDay为当月第一
天
If Day（StartDay） 1 Then
StartDay = DateValue（Month（StartDay） & 〃/1/〃 & _
Year（StartDay））
End If
' Prepare cell for Month and Year as fully spelled out。 准备年月的单元格，年月为完
整拼写
Range（〃a1〃）。NumberFormat = 〃mmmm yyyy〃
' Center the Month and Year label across a1：g1 with appropriate
' size； height and bolding。 将年月于A1：G1区域跨列居中显示，并设置字号，粗体何行高
With Range（〃a1：g1〃）
。HorizontalAlignment = xlCenterAcrossSelection
。VerticalAlignment = xlCenter
。Font。Size = 18
。Font。Bold = True
。RowHeight = 35
End With
' Prepare a2：g2 for day of week labels with centering； size；
' height and bolding。 设置A2：G2区域为星期标志，设置为居中，大小，行高和粗体
With Range（〃a2：g2〃）
lumnWidth = 11
。VerticalAlignment = xlCenter
。HorizontalAlignment = xlCenter
。VerticalAlignment = xlCenter
。Orientation = xlHorizontal
。Font。Size = 12
。Font。Bold = True
。RowHeight = 20
End With
' Put days of week in a2：g2。 输入星期
Range（〃a2〃） = 〃Sunday〃
Range（〃b2〃） = 〃Monday〃
Range（〃c2〃） = 〃Tuesday〃
Range（〃d2〃） = 〃Wednesday〃
Range（〃e2〃） = 〃Thursday〃
Range（〃f2〃） = 〃Friday〃
Range（〃g2〃） = 〃Saturday〃
' Prepare a3：g7 for dates with left/top alignment； size； height
' and bolding。 设置A3：G7区域为左对齐和上对齐，大小，行高和粗体
With Range（〃a3：g8〃）
。HorizontalAlignment = xlLeft
。VerticalAlignment = xlTop
。Font。Size = 18
。Font。Bold = True
。RowHeight = 21
End With
' Put input month and year fully spelling out into 〃a1〃。 在单元格A1里输入年月
Range（〃a1〃）。Value = Application。Text（MyInput； 〃mmmm yyyy〃）
' Set variable and get which day of the week the month starts。 设置变量，并获取该月第
一天的星期
DayofWeek = Weekday（StartDay）
' Set variables to identify the year and month as separate
' variables。 设置变量分别获取年和月
CurYear = Year（StartDay）
CurMonth = Month（StartDay）
' Set variable and calculate the first day of the next month。 设置变量并计算下个月地第
277
… 页面 294…
一天
FinalDay = DateSerial（CurYear； CurMonth ＋ 1； 1）
' Place a 〃1〃 in cell position of the first day of the chosen
' month based on DayofWeek。 基于星期序号，在选定月份第一天的位置放置“1”
Select Case DayofWeek
Case 1
Case 2
Case 3
Case 4
Case 5
Case 6
Case 7
Range（〃a3〃）。Value = 1
Range（〃b3〃）。Value = 1
Range（〃c3〃）。Value = 1
Range（〃d3〃）。Value = 1
Range（〃e3〃）。Value = 1
Range（〃f3〃）。Value = 1
Range（〃g3〃）。Value = 1
End Select
' Loop through range a3：g8 incrementing each cell after the 〃1〃
' cell。 在单元格区域A3：G8里面循环，在1之后，每个单元格增加1
For Each cell In Range（〃a3：g8〃）
RowCell = cell。Row
ColCell = celllumn
' Do if 〃1〃 is in first column。 如果1在第一列
If celllumn = 1 And cell。Row = 3 Then
' Do if current cell is not in 1st column。 如果当前单元格并非第一列
ElseIf celllumn 1 Then
If cell。Offset（0； …1）。Value 》= 1 Then
cell。Value = cell。Offset（0； …1）。Value ＋ 1
' Stop when the last day of the month has been
' entered。 当遇到当月的最后一天时，停止
If cell。Value 》 （FinalDay … StartDay） Then
cell。Value = 〃〃
' Exit loop when calendar has correct number of
' days shown。 当日历显示了正确的数字时，退出循环
Exit For
End If
End If
' Do only if current cell is not in Row 3 and is in Column 1。 仅当当前单元格不在第
三行，而在第一列时
ElseIf cell。Row 》 3 And celllumn = 1 Then
cell。Value = cell。Offset（…1； 6）。Value ＋ 1
' Stop when the last day of the month has been entered。 当遇到当月的最后一天
时，停止
If cell。Value 》 （FinalDay … StartDay） Then
cell。Value = 〃〃
Next ' Exit loop when calendar has correct number of days
' shown。 当日历显示了正确的数字时，退出循环
Exit For
End If
End If
278
… 页面 295…
' Create Entry cells； format them centered； wrap text； and border
' around days。 创建输入单元格，居中，自动换行，并在每日周围设置边框
For x = 0 To 5
Range（〃A4〃）。Offset（x * 2； 0）。EntireRow。Insert
With Range（〃A4：G4〃）。Offset（x * 2； 0）
。RowHeight = 65
。HorizontalAlignment = xlCenter
。VerticalAlignment = xlTop
。WrapText = True
。Font。Size = 10
。Font。Bold = False
' Unlock these cells to be able to enter text later after
' sheet is protected。 解开这些区域的锁定，以供将来输入文本
。Locked = False
End With
' Put border around the block of dates。 在每日周围设置边框
With Range（〃A3〃）。Offset（x * 2； 0）。Resize（2； _
7）。Borders（xlLeft）
。Weight = xlThick
lorIndex = xlAutomatic
End With
With Range（〃A3〃）。Offset（x * 2； 0）。Resize（2； _
7）。Borders（xlRight）
。Weight = xlThick
lorIndex = xlAutomatic
End With
Next
Range（〃A3〃）。Offset（x * 2； 0）。Resize（2； 7）。BorderAround _
Weight：=xlThick； ColorIndex：=xlAutomatic
If Range（〃A13〃）。Value = 〃〃 Then Range（〃A13〃）。Offset（0； 0） _
。Resize（2； 8）。EntireRow。Delete
' Turn off gridlines。 关闭网格线
ActiveWindow。DisplayGridlines = False
' Protect sheet to prevent overwriting the dates。 保护工作表，防止覆盖日期
ActiveSheet。Protect DrawingObjects：=True； Contents：
