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。