zt Worksheet物件 應用示例

ThisWorkbook.Worksheets("Sheet1").Activate

Worksheets.Add(Before,After,Count,Type)

工作表物件.Copy(Before,After)

ActiveSheet.Copy After:=Worksheets(Worksheets.Count)

工作表物件.Move(Before,After)

Worksheets("Sheet1").Move After:=Worksheets("Sheet3")

Worksheets("Sheet1").Name = "示例"

Sub ReNameSheet()
    Dim xStr As String
Retry:
    Err.Clear
    xStr = InputBox("請輸入工作表的新名稱:" _
       , "重新命名工作表", ActiveSheet.Name)
    If xStr = "" Then Exit Sub
    On Error Resume Next
    ActiveSheet.Name = xStr
    If Err.Number <> 0 Then
        MsgBox Err.Number & " " & Err.Description
        Err.Clear
        GoTo Retry
    End If
    On Error GoTo 0
     '.........
 End Sub

工作表物件.CodeName

Worksheets("Sheet1").Activate
Sheet1CodeName.Activate

工作表物件.Delete

Worksheets(1).Select (False)
Worksheets(2).Select (False)

工作表物件.Select(Replace)

Sub PreviousSheet()
    If ActiveSheet.Index <> 1 Then
        MsgBox "選取當前工作簿中當前工作表的前一個工作表"
        ActiveSheet.Previous.Activate
    Else
        MsgBox "已到第一個工作表"
    End If
End Sub

Sub NextSheet()
    If ActiveSheet.Index <> Worksheets.Count Then
        MsgBox "選取當前工作簿中當前工作表的下一個工作表"
        ActiveSheet.Next.Activate
    Else
        MsgBox "已到最後一個工作表"
    End If
End Sub

Sub WorksheetNum()
    Dim i As Long
    i = Worksheets.Count
    MsgBox "當前工作簿的工作表數為：" & Chr(10) & i
End Sub
 
Sub WorksheetNum()
    Dim i As Long
    i = Sheets.Count
    MsgBox "當前工作簿的工作表數為：" & Chr(10) & i
End Sub

工作表物件.SaveAs(FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AddToMru, TextCodepage, TextVisualLayout, Local)

Worksheets("Sheet1").Visible = False

Set NewSheet = Worksheets.Add
NewSheet.Visible = xlVeryHidden
NewSheet.Range("A1:D4").Formula = "=RAND()"

Sub UnhideAllWorksheets()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws
    Set ws = Nothing
End Sub

工作表物件.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables)

工作表物件.Unprotect(Password)

Sub ProtectSheet()
    MsgBox "保護當前工作表並設定密碼"
    ActiveSheet.Protect Password:="fanjy"
End Sub

Sub UnprotectSheet()
    MsgBox "撤銷當前工作表保護"
    ActiveSheet.Unprotect
End Sub

Sub ProtectAllWorkSheets()
    On Error Resume Next
    Dim ws As Worksheet
    Dim myPassword As String
    myPassword = InputBox("請輸入您的密碼" & vbCrLf & _
       "(不輸入表明無密碼)" & vbCrLf & vbCrLf & _
       "確保您沒有忘記密碼！", "輸入密碼")
    For Each ws In ThisWorkbook.Worksheets
        ws.Protect (myPassword)
    Next ws
End Sub

Sub UnprotectAllWorkSheets()
    On Error Resume Next
    Dim ws As Worksheet
    Dim myPassword As String
    myPassword = InputBox("請輸入您的密碼" & vbCrLf & _
        "(不輸入表示無密碼)", "輸入密碼")
    For Each ws In ThisWorkbook.Worksheets
        ws.Unprotect (myPassword)
    Next ws
End Sub

Sub OnlyEditUnlockedCells()
    Sheets("Sheet1").EnableSelection = xlUnlockedCells
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

工作表物件.PrintPreview(EnableChanges)

工作表物件.PrintOut(From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName, IgnorePrintAreas)

工作表物件.ShowDataForm

工作表物件.UsedRange

工作表物件.PasteSpecial(Format, Link, DisplayAsIcon, IconFileName, IconIndex, IconLabel, NoHTMLFormatting)

工作表物件.PasteSpecial(Format)

Worksheets("Sheet1").Range("D1").Select
ActiveSheet.PasteSpecial Format:= _
"Microsoft Word 12.0 Document Object"

Worksheets(1).Calculate

Worksheets(1).ScrollArea = "A1:C50"

Worksheets(1).ScrollArea = ""

工作表物件.SetBackgroundPicture(FileName)

Worksheets(1).SetBackgroundPicture "c:graphicswatermark.gif"

[應用28] Worksheets集合與Sheets集合
對於不熟悉Excel的人來說，可能會混淆Sheets集合和Worksheets集合之間的不同。Worksheets集合包含典型的Excel工作表（即通常我們說的工作表），即包含有行、列、單元格和公式等的工作表，而Sheets集合不僅僅是工作表的集合，而且也包含其它型別的工作表，例如圖表工作表、Excel 4.0宏工作表（也稱作XLM檔案）和Excel 5.0對話方塊工作表（允許建立自定義對話方塊）。圖表工作表是佔用了整個工作表的圖表，而不是插入作為工作表一部分的圖表。Excel 4工作表和Excel 5工作表用於保持Excel向後相容，並且也很容易轉換為新的工作表型別。進一步說，圖表工作表也組成了Charts集合。
Worksheets集合的Count屬性返回工作簿中工作表的數量，而Sheets集合的Count屬性則返回工作簿中所有工作表的數量，包含圖表工作表和工作表。例如，使用下面的語句新增指定數量的工作表到工作簿中：
Do While Worksheets.Count < 5
    ThisWorkbook.Sheets.Add
Loop
新增的工作表可以是圖表工作表或者是工作表，分別包含於Charts集合或Worksheets集合，或者是Sheets集合的成員。下面的程式碼修改工作簿中最後一個工作表的名稱：
Dim wrkSheetName As String
wrkSheetName = "Sample Chart"
Sheets(Sheets.Count).Name = wrkSheetName
注意，因為使用了Sheets集合，工作簿中最後一個工作表可能是工作表也可能是圖表工作表。
因為Sheets集合包含有更多型別的工作表，所以其包含的方法比Worksheets集合更多。然而，兩個集合都有新增、刪除、複製和移動工作表的方法。
[應用29]組合工作表
在Excel中，我們可以透過在按下Shift鍵或Ctrl鍵的同時，單擊其它工作表標籤來手工組合工作簿中的工作表。在VBA中，可以透過使用Worksheets集合的Select方法並結合Array函式來組合工作表。例如，下面的程式碼組合工作簿中的第1、第3和第5個工作表，並使第3個工作表成為活動工作表：
Worksheets(Array(1, 3, 5)).Select
Worksheets(3).Activate
也可以使用Worksheet物件的Select方法建立工作表組。首先按正常的方式選擇第1個工作表，然後透過使用Select方法並將其引數Replace設定為False，從而將其他工作表新增到組中。
Sub GroupWorksheets()
    Dim arrstrNames(1 To 3) As String
    Dim i As Integer
    arrstrNames(1) = "Sample1"
    arrstrNames(2) = "Sample2"
    arrstrNames(3) = "Sample3"
    Worksheets(arrstrNames(1)).Select
    For i = 2 To 3
        Worksheets(arrstrNames(i)).Select Replace:=False
    Next i
End Sub
然而，在VBA中組合工作表後，對工作表的更改將隻影響活動工作表，如果需要更改其他工作表，則需要使用迴圈語句遍歷工作表並作相應的更改。
Sub FormatWorksheetsGroup()
    Dim shts As Sheets
    Dim wks As Worksheet
    Set shts = Worksheets(Array(1, 3, 5))
    For Each wks In shts
        wks.Range("A1").Value = 100
        wks.Range("A1").Font.Bold = True
    Next wks
End Sub
[應用30]Activate方法與Select方法的區別
當需要啟用或者是選擇某個工作表時，使用Sheets(1).Activate和Sheets(1).Select的作用表面上看起來是相同的。但是，如果將需要啟用或者是選擇的工作表隱藏後，使用Sheets(1).Select將會出現錯誤，而使用Sheets(1).Activate則會正常執行，例如下面的程式碼：
'- - - 下面的程式碼執行正常 - - - -
Sub test1()
    Sheets(1).Visible = xlHidden
    Sheets(1).Activate
End Sub
'- - - 下面的程式碼執行錯誤，作用於物件的方法無效 - - - -
Sub test2()
    Sheets(1).Visible = xlHidden
    Sheets(1).Select
End Sub
Activate方法是用來啟用物件的方法，而Select方法是用來選取物件的方法，能使用Select方法一次選取多個工作表，但不能使用Activate方法一次啟用多個工作表，一次只能啟用一個工作表。詳見下面的程式碼示例：
'- - - 下面的程式碼執行正常 - - - -
Sub Test3()
    ActiveWorkbook.Sheets(Array(1, 2, 3)).Select
End Sub
'- - - 下面的程式碼執行錯誤，物件不支援該屬性和方法 - - - -
Sub Test4()
    ActiveWorkbook.Sheets(Array(1, 2, 3)).Activate
End Sub
當然，上述內容同樣適用於Worksheets集合。
[應用31]工作表名稱的使用
可以在程式碼中採用下面的三種方式引用工作表：
（1）該工作表在工作簿中的位置(索引號)。索引號自工作表標籤最左邊向右依次計數，最左邊的是第1個工作表，依次為第2個、3個……等等。
（2）該工作表的名稱，即在工作表左下角中看到的工作表標籤中的名稱。
（3）該工作表的物件名稱，即在建立工作表時自動分配給該工作表的名稱(在VBE編輯器中的工程視窗中可以看到)。
通常，在程式碼中引用工作表時，我們所使用的是工作表物件的Index屬性和Name屬性，例如 Worksheets(1).Select或者
Worksheets(”Sheet1″).Select。
但是，如果工作表的名稱被改變或者工作表被重新排序或者刪除其中的一些工作表後，則不能使用工作表物件的Name屬性或Index屬性引用所需要的工作表，這可能使已經編寫好的程式碼出現錯誤。因此，我們應該考慮雖然工作簿中的工作表改變但不影響工作表引用的辦法，可以使用工作表物件的名稱避免這種情況，即上面所講的第3種方式，無論是在工作簿中增加或刪除其它工作表，還是對工作表排序，或者是重新命名需要引用的該工作表，其物件名都不變（除非您刪除該工作表，或者是在VBE視窗中重新命名該物件）。工作表物件的名稱可以在VBE程式設計器中看到。例如，Sheet1(Sheet1)，左邊是工作表物件的名稱，右邊的括號中是工作表名，括號中的工作表名可以透過在工作簿介面中改變相應的工作表標籤名來改變，如果在工作表中重新命名Sheet1工作表為“資料工作表”，則工程屬性視窗中的名稱為：Sheet1(資料工作表)。如果工作表Sheet3的物件名稱是“主工作表”，而在Excel中，如果將工作表Sheet3的名稱修改為“資料工作表”，在VBE程式設計器的工程視窗中，“Sheet3”將變成“資料工作表”，但是該工作表的物件名稱仍為“主工作表”。
改變工作表物件名稱的方法是，透過改變屬性視窗中的(名稱)或者在程式碼中使用Properties(”_CodeName”)。下面的程式碼將會新增一個工作表並將該工作表的物件名稱命名為“ws_main”，這樣，在後面的程式碼中就可以使用該物件名稱來引用這個工作表，而不必擔心工作表名稱改變或工作表順序改變。
Sub ChageWksObjectName()
  Dim ws As Worksheet
  Dim sPrevCodeName As String
  Dim sNewCodeName As String
  '設定新物件的名稱
  sNewCodeName = "ws_main"
  '增加新工作表
  Set ws = Worksheets.Add
  '獲取新增工作表的物件名稱
  sPrevCodeName = ws.CodeName
  '變化新增工作表的物件名稱
  ThisWorkbook.VBProject.VBComponents(sPrevCodeName). _
                        Properties("_CodeName") = sNewCodeName
End Sub
Sub Test()
  ws_main.Range("A1").Value = "This is it!"
End Sub
注意，雖然使用工作表程式碼名稱有很多優點，例如不受使用者更改工作表名稱以及工作表順序的影響、容易處理複製貼上操作等，但是不可以跨工作簿使用工作表程式碼名稱，即不能在一個工作簿中使用另一個工作簿中的工作表程式碼名稱。
[應用32]引用工作表的方法
下面的示例簡單的介紹了工作表的引用方法。在示例中，使用了工作表Sheet1。
（1）指定工作表的位置啟用工作表。下面的程式碼啟用工作簿中的第1個工作表，即工作表標籤最左邊的工作表。（如果增加或刪除了其中某工作表，或者是對工作表進行排序後，可能引用的不是您想引用的工作表）
Sub ActivateFirstsheetInBook()
    Sheets(1).Activate
End Sub
或者：
Sub ReferenceShtByIndexNumber()
    Sheets(1).[A1:D4].Copy Sheets(2).[A1]
End Sub
（2）透過工作表的名稱啟用工作表，而不管工作表處於工作簿中的什麼位置以及工作表物件的程式碼名稱。（如果該工作表被重新命名後，執行程式碼會出錯）
Sub ActivateSheet1_1()
    Sheets("Sheet1").Activate
End Sub
或者：
Sub ReferenceShtByGivenName()
    [Sheet1!A1:D4].Copy [Sheet2!A1]
End Sub
（3）透過工作表物件的名稱啟用工作表，而不管該工作表處於工作簿中的什麼位置以及該工作表的名稱
Sub ActivateSheet1_2()
    Sheet1.Activate
End Sub
或者：
Sub ReferenceShtByCodeName()
    Sheet1.[A1:D4].Copy Sheet2.[A1]
End Sub
[應用33]判斷工作簿中是否存在指定名稱的工作表
[程式碼1]下面的函式判斷是否存在指定工作表名稱的工作表：
Function WorksheetExists(wb As Workbook, strName As String) As Boolean
    Dim str As String
    On Error GoTo worksheetExistsErr
    str = wb.Worksheets(strName).Name
    WorksheetExists = True
    Exit Function
worksheetExistsErr:
    WorksheetExists = False
End Function
如果指定名稱的工作表存在，WorksheetExists函式返回True，否則返回False，表示該工作表不存在。
[程式碼2]下面的函式判斷是否存在指定工作表程式碼名稱的工作表：
Function WorksheetCodeNameExists(wb As Workbook, sCodeName As String) As Boolean
    Dim str 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
[程式碼3]下面的函式判斷指定名稱的工作表是否存在
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
[程式碼4]下面的函式判斷指定名稱的工作表是否存在
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
[程式碼5]下面的函式判斷指定名稱的工作表是否存在
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
[程式碼6]下面的函式判斷指定名稱的工作表是否存在
Function SheetExists(sname) As Boolean
    '如果活動工作簿中存在該工作表則返回True
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True Else SheetExists = False
End Function
[程式碼7]下面的函式判斷工作表是否存在工作簿中
Function SheetExists(SName As String, Optional wb As Workbook) As Boolean
    Dim ws As Worksheet
    '預設使用活動工作表
    If wb Is Nothing Then
        Set wb = ActiveWorkbook
    End If
    On Error Resume Next
    SheetExists = CBool(Not wb.Sheets(SName) Is Nothing)
    On Error GoTo 0
End Function
[應用34]工作表行和列的操作
[示例1] 隱藏行
Sub HideRow()
  Dim iRow As Long
    MsgBox "隱藏當前單元格所在的行"
    iRow = ActiveCell.Row
    ActiveSheet.Rows(iRow).Hidden = True
    MsgBox "取消隱藏"
    ActiveSheet.Rows(iRow).Hidden = False
End Sub
[示例2] 隱藏列
Sub HideColumn()
    Dim iColumn As Long
    MsgBox "隱藏當前單元格所在列"
    iColumn = ActiveCell.Column
    ActiveSheet.Columns(iColumn).Hidden = True
    MsgBox "取消隱藏"
    ActiveSheet.Columns(iColumn).Hidden = False
End Sub
[示例3] 插入行
Sub InsertRow()
    Dim rRow As Long
    MsgBox "在當前單元格上方插入一行"
    rRow = Selection.Row
    ActiveSheet.Rows(rRow).Insert
End Sub
[示例4] 插入列
Sub InsertColumn()
  Dim cColumn As Long
    MsgBox "在當前單元格所在行的左邊插入一行"
    cColumn = Selection.Column
    ActiveSheet.Columns(cColumn).Insert
End Sub
[示例5] 插入多行
Sub InsertManyRow()
    MsgBox "在當前單元格所在行上方插入三行"
    Dim rRow As Long, i As Long
    For i = 1 To 3
        rRow = Selection.Row
        ActiveSheet.Rows(rRow).Insert
    Next i
End Sub
[示例6] 設定行高
Sub SetRowHeight()
    MsgBox "將當前單元格所在的行高設定為25"
    Dim rRow As Long, iRow As Long
    rRow = ActiveCell.Row
    iRow = ActiveSheet.Rows(rRow).RowHeight
    ActiveSheet.Rows(rRow).RowHeight = 25
    MsgBox "恢復到原來的行高"
    ActiveSheet.Rows(rRow).RowHeight = iRow
End Sub
[示例7] 設定列寬
Sub SetColumnWidth()
    MsgBox "將當前單元格所在列的列寬設定為20"
    Dim cColumn As Long, iColumn As Long
    cColumn = ActiveCell.Column
    iColumn = ActiveSheet.Columns(cColumn).ColumnWidth
    ActiveSheet.Columns(cColumn).ColumnWidth = 20
    MsgBox "恢復至原來的列寬"
    ActiveSheet.Columns(cColumn).ColumnWidth = iColumn
End Sub
[示例8] 恢復行高列寬至標準值
Sub ReSetRowHeightAndColumnWidth()
    MsgBox "將當前單元格所在的行高和列寬恢復為標準值"
    Selection.UseStandardHeight = True
    Selection.UseStandardWidth = True
End Sub
[應用35]工作表標籤操作
[示例1] 設定工作表標籤的顏色
Sub SetSheetTabColor()
    MsgBox "設定當前工作表標籤的顏色"
    ActiveSheet.Tab.ColorIndex = 7
End Sub
[示例2] 恢復工作表標籤顏色
Sub SetSheetTabColorDefault()
    MsgBox "將當前工作表標籤顏色設定為預設值"
    ActiveSheet.Tab.ColorIndex = -4142
End Sub
[示例3] 交替隱藏或顯示工作表標籤
Sub HideOrShowSheetTab()
    MsgBox "隱藏/顯示工作表標籤"
    ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
End Sub
[應用36]確定列印的頁數(HPageBreaks屬性與VPageBreaks屬性)
Sub PageCount()
    Dim i As Long
    i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
    MsgBox "當前工作表共" & i & "頁."
End Sub
[應用37]排序工作表
方法1：下面是《Writing Excel Macros with VBA》中的一個示例，摘錄於此。
首先驗證使用者是否想排序工作表，如果是則呼叫SortAllSheets過程來完成排序。
Sub SortSheets()
    If MsgBox("想排序工作表嗎?", vbOKCancel + vbQuestion, "排序工作表") = vbOK Then
        SortAllSheets
    End If
End Sub
下面的程式碼首先將工作表的名稱放置在陣列中，然後新增新工作表，將代表工作表名稱的陣列元素放置在新工作表的第1列，接著對該列排序，將排序好的元素放回陣列，並刪除新增的工作表，最後使用Move方法重新排列工作表，從而完成工作表排序。
Sub SortAllSheets()
    '排序工作表
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range, i As Integer
    Dim cSheets As Integer
    Dim sSheets() As String
 
    Set wb = ActiveWorkbook
 
    '獲取陣列的實際大小
    cSheets = wb.Sheets.Count
    ReDim sSheets(1 To cSheets)
 
    '使用工作表名稱填充陣列
    For i = 1 To cSheets
        sSheets(i) = wb.Sheets(i).Name
    Next
 
    '建立新的工作表並在其第一列放置名稱
    Set ws = wb.Worksheets.Add
    For i = 1 To cSheets
        ws.Cells(i, 1).Value = sSheets(i)
    Next
 
    '排序列
    ws.Columns(1).Sort Key1:=ws.Columns(1), Order1:=xlAscending
 
    '重新填充陣列
    For i = 1 To cSheets
        sSheets(i) = ws.Cells(i, 1).Value
    Next
 
    '刪除臨時工作表
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
 
    '透過移動每個工作表到最後來重新排列工作表
    For i = 1 To cSheets
        wb.Sheets(sSheets(i)).Move After:=wb.Sheets(cSheets)
    Next
End Sub
方法2：下面是《Mastering Excel 2003 Programming with VBA》一書中的示例，使用冒泡法排序，摘錄於此。
Sub AlphabetizeWorksheets(wb As Workbook)
    Dim bSorted As Boolean
    Dim nSheetsSorted 
                                        

                    

                                                    來自 “ ITPUB部落格 ” ，連結：http://blog.itpub.net/7868752/viewspace-1057394/，如需轉載，請註明出處，否則將追究法律責任。
                                            

                
            
                            

                    
                    
0
                    
0
                    

                        

                            分享到：
                            
                            
                            
                            
                        

                        

                

                

                    

                        上一篇：
                                                    Excel Application物件 開發指南
                        
                    
                    

                        下一篇：
                                                    zt 總結歷時一年（2009年)的網工之路
                                            
                

                


                
                

                    

                        
                        
                        
                            
                        

                        

                            請登入後發表評論
                            
                                登入
                            
                        

                        
                        


                    
                    

                        
全部評論