excel_vba_编程教程(完整版)-第88章
按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 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窗口，并且
在工作表标签的任意地方单击右键，从快捷
