'使用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：确认一个工作表名称在使用其之前已存在

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

'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) =  Then

            WorksheetCodenameExists = True

            Exit For

        End If

    Next

    Set ws = Nothing

End Function

'代码清单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: 取消隐藏工作薄中的每一个工作表

'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.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方法解除工作表保护

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()

    '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

'通过名称指定参数

ThisWorkbook.Worksheets.Add Count:=, Before:= ThisWorkbook.Worksheets()

'通过顺序指定参数

ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(), ,

Sub TestDelete()

    '删除工作薄的第一个工作表

    ThisWorkbook.Worksheets().Delete

End Sub

'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) >  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 =

    For nSheetIndex =  To wb.Sheets.Count

        If wb.Sheets(nSheetIndex).Visible = xlSheetVisible Then

            nCount = nCount +

        End If

    Next

    CountVisibleSheets = nCount

End Function

Sub SimpleWorksheetMovement()

    '复制第3个工作表到新建的工作薄

    ThisWorkbook.Worksheets().Copy

    '复制第3个工作表到第2个工作表之前

    ThisWorkbook.Worksheets().Copy ThisWorkbook.Worksheets()

    '移动第2个工作表到工作薄的末尾

    ThisWorkbook.Worksheets().Move _

        After := ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

End Sub

'代码清单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 = 

    Do While (nSheetsSorted < nSheets) And Not bSorted

        bSorted = True

        nSheetsSorted = nSheetsSorted +

        For n =  To nSheets - nSheetsSorted

            If StrComp(wb.Worksheets(n).Name, wb.Worksheets(n + ).Name, vbTextCompare) >  Then

                'out of order - swap the sheets

                wb.Worksheets(n + ).Move beforfore:=wb.Worksheets(n)

                bSorted = False

            End If

        Next

    Loop

End Sub

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  < Width And Width <  Then

            Me.Columns.ColumnWidth = Width

        ElseIf Width =  Then

            Me.Columns.ColumnWidth = Me.StandardWidth

        End If

    End If

End Sub

Sub ChangeRowHeight(Height As Variant)

    If IsNumeric(Height) Then

        If  <  Height And Height <  Then

            Me.Rows.RowHeight = Height

        ElseIf Height =  Then

            Me.Rows.RowHeight = Me.StandardHeight

        End If

    End If

End Sub