内容发布更新时间 : 2024/5/11 16:40:45星期一 下面是文章的全部内容请认真阅读。

[示例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