按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
月第一天
' 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：=True； _
Scenarios：=True
' Resize window to show all of calendar （may have to be adjusted
' for video configuration）。 设置窗口大小以显示完整日历
ActiveWindow。WindowState = xlMaximized
ActiveWindow。ScrollRow = 1
' Allow screen to redraw with calendar showing。 允许屏幕重绘日历显示
Application。ScreenUpdating = True
' Prevent going to error trap unless error found by exiting Sub
' here。 放置没有错误时也允许错误陷阱
Exit Sub
' Error causes msgbox to indicate the problem； provides new input box； 错误导致信
息框指明问题，提供新的输入框
' and resumes at the line that caused the error。 并恢复至导致错误的代码行
MyErrorTrap：
MsgBox 〃You may not have entered your Month and Year correctly。〃 _
& Chr（13） & 〃Spell the Month correctly〃 _
& 〃 （or use 3 letter abbreviation）〃 _
& Chr（13） & 〃and 4 digits for the Year〃
MyInput = InputBox（〃Type in Month and year for Calendar〃）
If MyInput = 〃〃 Then Exit Sub
Resume
End Sub
279
… 页面 296…
事件名称 新建工作表
事件描述 示例18当用户新建一个工作表后，引发 该事件
Private Sub Workbook_NewSheet（ByVal Sh As Object）
If MsgBox（〃Do you want to place 〃 & vbCrLf _
& 〃the new sheet at the beginning 〃 & vbCrLf _
& 〃of the workbook？〃； vbYesNo） = vbYes Then
Sh。Move before：=ThisWorkbook。Sheets（1）
Else
Sh。Move After：=ThisWorkbook。Sheets（ _
ThisWorkbook。Sheetsunt）
MsgBox Sh。Name & _
〃 is now the last sheet in the workbook。〃
End If
End Sub
当用户在弹出的信息框上点击是的话，示例程序就会将新建的工作表置于工作簿的开始，否则在结
尾
示例18 – 试验：打开一个新工作簿，在VB编辑器窗口，激活工程浏览器窗口并且打开Excel对象
文件夹。双击ThisWorkbook并 且输入示例程序于ThisWorkbook代码窗口。切换到Excel窗口，并且
在工作表标签的任意地方单击右键，从快捷菜单上选择插入， 选择你想要插入的工作表类型，并
点击确定。Excel将会问你将新建的工作表放置到什么地方。下面是一个Excel工作表可以响应的
事件列表。
事件名称 描述
SheetActivate 当用户激活当前工作簿里的任何工作表发
生该事件。SheetActivate事件 同样也可
以发生在应用软件级别，当你激活任意打
开的工作簿里的任意 工作表时，都会激活
该事件
SheetDeactivate 当用户激活工作簿里一个不同的工作表时，引发该事件
SheetSelectionChange 当用户选择不同单元格时，引发该事件。
该事件发生在该工作簿里的每 个工作表
上
SheetChange 本事件发生在用户更改单元格内容时
SheetCalculate 本事件发生在用户重新计算工作表的时候
SheetBeforeDoubleClick 当用户双击工作表上的单元格时，引发该事件
SheetBeforeRightClick 当用户在工作表单元格上单击右键时，引发该事件
事件名称 激活窗口
事件描述 示例19
当用户激活任何显示该工作簿的
窗口时，引发该事件 Private Sub Workbook_WindowActivate（ByVal _
Wn As Window）
Wn。GridlineColor = vbYellow
End Sub
当用户激活包含Workbook_WindowActivate程序的工作簿时，示例程序将更改工作表的网格线颜色
为黄色
示例19 – 试验：在VB编辑器窗口，激活工程浏览器窗口并打开Excel对象文件夹。双击
ThisWorkbook，并输入示例程序。切换 到Excel窗口，打开一个全新的工作簿。使用窗口菜单将
Excel工作簿设置为竖直并排排列。当你激活含有示例程序的工作簿时， 网格线应该会变为黄色
了。
事件名称 窗口失活
事件描述 示例20
280
… 页面 297…
当用户将焦点从该工作簿窗口移 走时，引发该事件
Private Sub Workbook_WindowDeactivate（ByVal _
Wn As Window）
Wn。GridlineColor = vbRed
End Sub
当用户从包含Workbook_WindowActivate过程代码的工作簿切换到另外一个
工作簿时，示例程序将其网格 线设置为红色
示例20 – 试验：在VB编辑器窗口，激活工程浏览器窗口并打开Excel文件夹，双击ThisWorkbook
并输入示例程序。切换到Excel 窗口，打开一个全新的工作簿。使用窗口菜单将所有Excel工作簿
设置为竖直排列。当你失活包含Workbook_WindowDeactivate 事件代码的工作簿并切换到空工作
簿时，被失活地工作表里的网格线就会被变为红色。
事件名称 窗口调整大小
事件描述 示例21
当用户打开窗口，调整窗口大小， 最大化或者最小化窗口时，引发 该事件
Private Sub Workbook_WindowResize（ByVal Wn As Window）
If Wn。WindowState xlMaximized Then
Wn。Left = 0
Wn。Top = 0
End If
End Sub
当用户调整窗口大小时，示例程序将工作簿窗口移至屏幕的左上角
示例21 – 试验：在VB编辑器窗口，激活工程浏览器窗口并且打开Excel对象文件夹。双击
ThisWorkbook并输入示例程序。切换 到Excel窗口并且点击还原按钮（工作簿，非Excel应用软件）。
通过拖曳窗口内部边框改变当前活动窗口大小时，一旦你完成大 小调整操作，该工作簿窗口会
自动跳到屏幕的左上角（Excel应用软件窗口的左上角）。
下述表格描述了Excel 2002里增加的工作簿事件。
事件名称 描述
PivotTableOpenConnection 当数据透视表报告打开对其数据源的连接时发生该事件。该事件
要求你 在类模块里面使用WithEvents关键字声明一个
Application或者Workbook类型对象。（参见“图表事件”和“应
用程序对象识别的事 件”部分有关该关键字使用的示例）
PivotTableCloseConnection 当数据透视表报告关闭对其数据源的连接
后发生该事件。该事件要求你 在类模块里
面使用WithEvents关键字声明一个
Application或者 Workbook类型对象。
（参见“图表事件”和“应用程序对象识