7 Worksheet 对象

7.1 设置阶段

代码清单7.1：使用Parent属性得到一个对象的父对象的指针

'使用Parent属性得到一个对象的父对象的指针
Sub MeetMySingleParent()
    'Declare a worksheet variable named ws
    Dim ws As Worksheet
    
    'set ws to refer to sheet 1
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    'please meet my parent - Mrs. Workbook
    Debug.Print ws.Parent.Name
    
    Set ws = Nothing   
End Sub

 

以编程方式区分出代码名称和实际名称 

'prints out name & code name
'assumes a worksheet has been named
'in the vbe as: wsMenu

Dim wsMenu As Worksheet ' = ThisWorkbook.Worksheets(1)
Sub WhatsMyName()
    On Error Resume Next
    
    Debug.Print "The name on my worksheet tab is " & wsMenu.Name & ", " & vbCrLf
    Debug.Print "But you can call me " & wsMenu.CodeName    
End Sub

 

7.2 在使用工做表以前确认它们

代码清单7.2：确认一个工做表名称在使用其以前已存在

'代码清单7.2：确认一个工做表名称在使用其以前已存在
Function WorksheetExists(wb As Workbook, sName As String) As Boolean
    Dim s As String
    On Error GoTo bWorksheetExistsErr
    s = wb.Worksheets(sName).Name
    WorksheetExists = True
    Exit Function
bWorksheetExistsErr:
    WorksheetExists = False    
End Function

 

代码清单7.3：使用函数检查代码名称的存在性

'determines if a given worksheet name exists in a workbook
'checks by looking for the code name rather than the name
Function WorksheetCodenameExists(wb As Workbook, sCodename As String) As Boolean
    Dim s As String
    Dim ws As Worksheet
    
    WorksheetCodenameExists = False
    For Each ws In wb.Worksheets
        If StrComp(ws.CodeName, sCodename, vbTextCompare) = 0 Then
            WorksheetCodenameExists = True
            Exit For
        End If
    Next
    Set ws = Nothing
End Function

 

7.3 隐藏与取消隐藏

代码清单7.4：隐藏和取消隐藏工做表

'代码清单7.4: 隐藏和取消隐藏工做表
'/Hides the worksheet named sName
Sub HideWorksheet(sName As String, bVeryHidden As Boolean)
    If WorksheetExists(ThisWorkbook, sName) Then
        If bVeryHidden Then
            ThisWorkbook.Worksheets(sName).Visible = xlSheetVeryHidden
        Else
            ThisWorkbook.Worksheets(sName).Visible = xlSheetHidden
        End If
    End If
End Sub

Sub UnhideWorksheet(sName As String)
    If WorksheetExists(ThisWorkbook, sName) Then
        ThisWorkbook.Worksheets(sName).Visible = xlSheetVisible
    End If
End Sub

Sub UsingHideUnhide()
    Dim lResponse As Long
    
    'Hide the worksheet
    HideWorksheet "Sheet2", True
    
    'Show that it is hidden - ask to unhide
    lResponse = MsgBox("the worksheet is very hidden. unhide?", vbYesNo)
    
    If lResponse = vbYes Then
        UnhideWorksheet "Sheet2"
    End If    
End Sub

 

代码清单7.5：取消隐藏工做薄中的每个工做表

'代码清单7.5: 取消隐藏工做薄中的每个工做表
'Unhides all worksheets in the workbook, even very hidden worksheets
Sub UnhideAllWorksheets()
    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws

    Set ws = Nothing    
End Sub

 

7.4 锁住关键内容

代码清单7.6：利用Protect方法保护工做表

'代码清单7.6: 利用Protect方法保护工做表
Function ProtectWorksheet(ws As Worksheet, sPassword As String) As Boolean
    On Error GoTo ErrHandler
    If Not ws.ProtectContents Then
        ws.Protect sPassword, True, True, True
    End If
    
    ProtectWorksheet = True
    Exit Function
ErrHandler:
    ProtectWorksheet = False
End Function

 

代码清单7.7：利用Unprotect方法解除工做表保护

'代码清单7.7: 利用Unprotect方法解除工做表保护
Function UnprotectWorksheet(ws As Worksheet, sPassword As String) As Boolean
    On Error GoTo ErrHandler
    If ws.ProtectContents Then
        ws.Unprotect sPassword
    End If
    UnprotectWorksheet = True    
    Exit Function
ErrHandler:
    UnprotectWorksheet = False    
End Function

Sub TestProtection()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    'example of how you might use protectworksheet
    If Not ProtectWorksheet(ws, "TestPassword") Then
        Debug.Print "the worksheet could not be protected."
    Else
        Debug.Print "the worksheet has been protected."
    End If

    'example of how you might use unprotect worksheet
    If UnprotectWorksheet(ws, "testpassword") Then
        'unprotected - safe to modify the worksheet
        'contents pogrammatically now...
        Debug.Print "the worksheet has been unprotected."
    Else
        Debug.Print "the worksheet could not be unprotected."
    End If
    
    Set ws = Nothing
End Sub

 

7.5 管理工做薄工做表

7.5.1 增长和删除工做表

增长工做表的语法：

ThisWorkbook.Worksheets.Add [Before|After],[Count],[Type]

VBA调用方法或函数除了按位置设置实参，还能够按名称设置实参，当指定参数名称时，不须要按照顺序放置参数。

'经过名称指定参数
ThisWorkbook.Worksheets.Add Count:=2, Before:= ThisWorkbook.Worksheets(2)
'经过顺序指定参数
ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(2), ,2

删除工做表的实例：

Sub TestDelete()
    '删除工做薄的第一个工做表
    ThisWorkbook.Worksheets(1).Delete
End Sub

上面代码执行，可能会弹出删除工做表的确认对话框。能够经过Application对象的DisplayAlerts属性关闭这个功能。

代码清单7.8：使用DeleteSheet函数安全删除工做表

'Deletes the worksheet given in the ws parameter
'if bQuiet then do not display Excel alerts
Function DeleteSheet(ws As Worksheet, bQuiet As Boolean) As Boolean
    Dim bDeleted As Boolean
    
    On Error GoTo ErrHandler
    
    bDeleted = False
    
    If CountVisibleSheets(ws.Parent) > 1 Then
        'ok to delete - display alerts?
        If bQuiet Then Application.DisplayAlerts = False
        
        'finally! delete the darn thing
        bDeleted = ws.Parent.Worksheets(ws.Name).Delete
    Else
        'forget it - 
        'need at least one visible sheet in a workbook, 
        'bDeleted is already false
    End If
    
ExitPoint:
    'make sure display alerts is always on
    Application.DisplayAlerts = True
    DeleteSheet = bDeleted
    Exit Function

ErrHandler:
    bDeleted = False
    Resume ExitPoint
End Function

'returns a count of all of the visible sheets in the workbook wb
Function CountVisibleSheets(wb As Workbook) As Integer
    Dim nSheetIndex As Integer
    Dim nCount As Integer
    nCount = 0
    For nSheetIndex = 1 To wb.Sheets.Count
        If wb.Sheets(nSheetIndex).Visible = xlSheetVisible Then
            nCount = nCount + 1
        End If
    Next
    CountVisibleSheets = nCount
End Function

 

7.5.2 移动和复制工做表

移动和复制工做表的语法：

worksheet.Move [Before|After]

worksheet.Copy [Before|After]

Before|After是Worksheet对象，若是没有指定，则worksheet被放置到一个新建的工做薄中。

Sub SimpleWorksheetMovement()
    '复制第3个工做表到新建的工做薄
    ThisWorkbook.Worksheets(3).Copy
    '复制第3个工做表到第2个工做表以前
    ThisWorkbook.Worksheets(3).Copy ThisWorkbook.Worksheets(2)    
    '移动第2个工做表到工做薄的末尾
    ThisWorkbook.Worksheets(2).Move _
        After := ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
End Sub

 

代码清单7.9：在工做薄中按字母顺序排序工做表

'代码清单7.9: 在工做薄中按字母顺序排序工做表
'performs a simple bubble sort to
'sort the worksheets in the workbook
Sub AlphabetizeWorksheets(wb As Workbook)
    Dim bSorted As Boolean
    Dim nSheetsSorted As Integer
    Dim nSheets As Integer
    Dim n As Integer
    
    nSheets = wb.Worksheets.Count
    nSheetsSorted = 0
    
    Do While (nSheetsSorted < nSheets) And Not bSorted
        bSorted = True
        nSheetsSorted = nSheetsSorted + 1
        For n = 1 To nSheets - nSheetsSorted
            If StrComp(wb.Worksheets(n).Name, wb.Worksheets(n + 1).Name, vbTextCompare) > 0 Then
                'out of order - swap the sheets
                wb.Worksheets(n + 1).Move beforfore:=wb.Worksheets(n)
                bSorted = False
            End If
        Next
    Loop
End Sub

 

7.6 说明工做表事件

在选择响应的事件以前，确认在工程浏览器中选择了适当的工做表

代码清单7.10：使用Change事件响应工做表改变

Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address
        Case "$B$1"
            ChangeColumnWidth Target.Value
        Case "$B$2"
            ChangeRowHeight Target.Value
    End Select
End Sub

Sub ChangeColumnWidth(Width As Variant)
    If IsNumeric(Width) Then
        If 0 < Width And Width < 100 Then
            Me.Columns.ColumnWidth = Width
        ElseIf Width = 0 Then
            Me.Columns.ColumnWidth = Me.StandardWidth
        End If
    End If
End Sub

Sub ChangeRowHeight(Height As Variant)
    If IsNumeric(Height) Then
        If 0 <  Height And Height < 100 Then
            Me.Rows.RowHeight = Height
        ElseIf Height = 0 Then
            Me.Rows.RowHeight = Me.StandardHeight
        End If
    End If
End Sub

注意，清单中的Me表明Worksheet。