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。