[示例04-11-08]恢复行高列宽至标准值 Sub ReSetRowHeightAndColumnWidth()
MsgBox \将当前单元格所在的行高和列宽恢复为标准值\ Selection.UseStandardHeight = True Selection.UseStandardWidth = True End Sub
[示例04-12]工作表标签
[示例04-12-01] 设置工作表标签的颜色 Sub SetSheetTabColor()
MsgBox \设置当前工作表标签的颜色\ ActiveSheet.Tab.ColorIndex = 7 End Sub
[示例04-12-01]恢复工作表标签颜色 Sub SetSheetTabColorDefault()
MsgBox \将当前工作表标签颜色设置为默认值\ ActiveSheet.Tab.ColorIndex = -4142 End Sub
[示例04-12-03]交替隐藏或显示工作表标签 Sub HideOrShowSheetTab()
MsgBox \隐藏/显示工作表标签\
ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs End Sub
[NextPage][示例04-13]确定打印的页数(HPageBreaks属性与VPageBreaks属性)
Sub PageCount() Dim i As Long
i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1) MsgBox \当前工作表共\页.\End Sub
[示例04-14]保护/撤销保护工作表 [示例04-14-01] Sub ProtectSheet()
MsgBox \保护当前工作表并设定密码\ ActiveSheet.Protect Password:=\End Sub
示例说明：运行代码后，当前工作表中将不允许编辑，除非撤销工作表保护。
[示例04-14-02]
Sub UnprotectSheet()
MsgBox \撤销当前工作表保护\ ActiveSheet.Unprotect End Sub
示例说明：运行代码后，如果原保护的工作表设置有密码，则要求输入密码。
[示例04-14-03]保护当前工作簿中的所有工作表 Sub ProtectAllWorkSheets() On Error Resume Next Dim ws As Worksheet
Dim myPassword As String
myPassword = InputBox(\请输入您的密码\ \不输入表明无密码)\ \确保您没有忘记密码！\输入密码\ For Each ws In ThisWorkbook.Worksheets ws.Protect (myPassword) Next ws End Sub
[示例04-14-04]撤销对当前工作簿中所有工作表的保护 Sub UnprotectAllWorkSheets() On Error Resume Next Dim ws As Worksheet
Dim myPassword As String
myPassword = InputBox(\请输入您的密码\ \不输入表示无密码)\输入密码\ For Each ws In ThisWorkbook.Worksheets ws.Unprotect (myPassword) Next ws End Sub
[示例04-14-05]仅能编辑未锁定的单元格 Sub OnlyEditUnlockedCells()
Sheets(\
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub
示例说明：运行本代码后，在当前工作表中将只能对未锁定的单元格进行编辑，而其它单元格将不能编辑。未锁定的单元格是指在选择菜单“格式——单元格”命令后所弹出的对话框中的“保护”选项卡中，未选中“锁定”复选框的单元格或单元格区域。
[示例04-15]删除工作表(Delete方法) Sub DeleteWorksheet()
MsgBox \删除当前工作簿中的工作表sheet2\ Application.DisplayAlerts = False Worksheets(\
Application.DisplayAlerts = True End Sub
示例说明：本示例代码使用Application.DisplayAlerts = False来屏蔽弹出的警告框。
<一些编程方法和技巧>
[示例04-16] 判断一个工作表(名)是否存在 [示例04-16-01]
Sub testWorksheetExists1() Dim ws As Worksheet
If Not WorksheetExists(ThisWorkbook, \ MsgBox \不能够找到该工作表\ Exit Sub End If
MsgBox \已经找到工作表\
Set ws = ThisWorkbook.Worksheets(\End Sub
'- - - - - - - - - - - - - - - - - - -
Function WorksheetExists(wb As Workbook, sName As String) As Boolean Dim s As String
On Error GoTo ErrHandle
s = wb.Worksheets(sName).Name WorksheetExists = True Exit Function ErrHandle:
WorksheetExists = False End Function
示例说明：在测试代码中，用相应的工作簿名和工作表名分别代替
“ThisWorkbook”和“Sheet1”，来判断指定工作表是否在工作簿中存在。
[示例04-16-02]
Sub testWorksheetExists2()
If Not SheetExists(\工作表名>\ MsgBox \工作表名> 不存在!\ Else
Sheets(\工作表名>\ End If End Sub
'- - - - - - - - - - - - - - - - - - -
Function SheetExists(SheetName As String) As Boolean SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then SheetExists = True Exit Function End If
NoSuchSheet: End Function
示例说明：在代码中，用实际工作表名代替<>。
[示例04-16-03]
Sub TestingFunction()
'如果工作表存在则返回True，否则为False '测试DoesWksExist1函数
Debug.Print DoesWksExist1(\ Debug.Print DoesWksExist1(\ Debug.Print \ '测试DoesWksExist2函数
Debug.Print DoesWksExist2(\ Debug.Print DoesWksExist2(\End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Function DoesWksExist1(sWksName As String) As Boolean Dim i As Long
For i = Worksheets.Count To 1 Step -1 If Sheets(i).Name = sWksName Then Exit For End If Next
If i = 0 Then
DoesWksExist1 = False Else
DoesWksExist1 = True End If
End Function
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Function DoesWksExist2(sWksName As String) As Boolean Dim wkb As Worksheet On Error Resume Next
Set wkb = Sheets(sWksName) On Error GoTo 0
DoesWksExist2 = IIf(Not wkb Is Nothing, True, False) End Function
[示例04-17]排序工作表 [示例04-17-01]
Sub SortWorksheets1() Dim bSorted As Boolean Dim nSortedSheets As Long Dim nSheets As Long Dim n As Long
nSheets = Worksheets.Count nSortedSheets = 0
Do While (nSortedSheets < nSheets) And Not bSorted bSorted = True
nSortedSheets = nSortedSheets + 1 For n = 1 To nSheets - nSortedSheets
If StrComp(Worksheets(n).Name, Worksheets(n + 1).Name, vbTextCompare) > 0 Then
Worksheets(n + 1).Move Before:=Worksheets(n) bSorted = False End If Next n Loop End Sub
示例说明：本示例代码采用了冒泡法排序。
[示例04-17-02]
Sub SortWorksheets2() '根据字母对工作表排序 Dim i As Long, j As Long For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then Sheets(j).Move After:=Sheets(j + 1) End If Next j Next i End Sub
[示例04-17-03]
Sub SortWorksheets3() '以升序排列工作表
Dim sCount As Integer, i As Integer, j As Integer Application.ScreenUpdating = False sCount = Worksheets.Count If sCount = 1 Then Exit Sub For i = 1 To sCount - 1