實用VBA語句集(第2輯)

'*******************************************************
'      定製模塊行為
'(101)清除程序運行過程中所有的錯誤
      Err.Clear
'*******************************************************
'      工作簿
'(102)返回上次保存工作簿的日期和時間
       ThisWorkbook.BuiltinDocumentProperties ("Last Save Time")
       '或
       Application.Caller.Parent.Parent.BuiltinDocumentProperties ("Last Save Time")
'(103)返回上次打印或預覽工作簿的日期和時間
       ThisWorkbook.BuiltinDocumentProperties ("Last Print Date")
       '或
       Application.Caller.Parent.Parent.BuiltinDocumentProperties ("Last Print Date")
'(104)關閉所有打開的工作簿
      Workbooks.Close
'(105)返回當前工作簿中的第一條鏈接
      ActiveWorkbook.LinkSources(xlExcelLinks)(1)
'(106)返回工作簿代碼的名稱
       ActiveWorkbook.CodeName
       ThisWorkbook.CodeName
'(107)返回當前工作簿文件格式代碼
       ActiveWorkbook.FileFormat
       ThisWorkbook.FileFormat
'(108)返回當前工作簿的路徑(註:若工作簿未保存,則為空)
       ThisWorkbook.Path
       ActiveWorkbook.Path
'(109)返回當前工作簿的讀/寫值(為False)
       ThisWorkbook.ReadOnly
       ActiveWorkbook.ReadOnly
'(110)返回工作簿的存儲值(若已保存則為False)
       ThisWorkbook.Saved
      ActiveWorkbook.Saved
'(111)隱藏工作簿
      Application.Visible = False
      '顯示工作簿
      Application.Visible = True
      '註:可與用戶窗體配合使用,即在打開工作簿時將工作簿隱藏,只顯示用戶窗體.可設置控制按鈕控制工作簿可見
'*******************************************************
'      工作表
'(112)在A列右側插入列，即插入B列
      ActiveSheet.Columns("B").Insert
'      ActiveSheet.Columns("E").Cut
      '以上兩句將E列數據移至B列，原B列及以後的數據相應後移
        ActiveSheet.Columns("B").Insert
'      ActiveSheet.Columns("B").Cut
      '以上兩句將B列數據移至D列，原C列和D列數據相應左移一列
        ActiveSheet.Columns("E").Insert
'(113)計算當前工作表
      ActiveSheet.Calculate
'(114)正常隱藏工作表，同在Excel菜單中選擇"格式——工作表——隱藏"操作一樣
      ThisWorkbook.Worksheets("sheet1").Visible = xlSheetHidden
      '隱藏工作表，不能通過在Excel菜單中選擇"格式——工作表——取消隱藏"來重新顯示工作表
      ThisWorkbook.Worksheets("sheet1").Visible = xlSheetVeryHidden
      '顯示被隱藏的工作表
      ThisWorkbook.Worksheets("sheet1").Visible = xlSheetVisible
'(115)檢查工作表是否受到保護
      ThisWorkbook.Sheets(1).ProtectContents
'(116)在第二個工作表之前添加兩個新的工作表
       ThisWorkbook.Worksheets.Add Count:=2, _
                  Before:=ThisWorkbook.Worksheets(2)
      '或
      ThisWorkbook.Workshees.Add ThisWorkbook.Worksheets(2), , 2
'(117)複製一個工作表到新的工作簿
      ThisWorkbook.Worksheets(3).Copy
'(118)複製第三個工作表到第二個工作表之前
      ThisWorkbook.Worksheets(3).Copy ThisWorkbook.Worksheets(2)
'(119)改變工作表的列寬為20
      ThisWorkbook.ActiveSheet.Columns.ColumnWidth = 20
      '將工作表的列寬恢復為標準值
      ThisWorkbook.ActiveSheet.Columns.ColumnWidth = _
                   ThisWorkbook.ActiveSheet.StandardWidth
      '改變工作表列1的寬度為20
      ThisWorkbook.ActiveSheet.Columns(1).ColumnWidth = 20
'(120)改變工作表的行高為10
      ThisWorkbook.ActiveSheet.Rows.RowHeight = 10
      '將工作表的行高恢復為標準值
      ThisWorkbook.ActiveSheet.Rows.RowHeight = _
                   ThisWorkbook.ActiveSheet.StandardHeight
      '改變工作表的行1的高度值設置為10
      ThisWorkbook.ActiveSheet.Rows(1).RowHeight = 10
'(121)當前工作簿中的第一個工作表被激活
      ThisWorkbook.Worksheets(1).Activate
'(122)設置工作表Sheet1中的行1數據為粗體
      ThisWorkbook.Worksheets("Sheet1").Rows(1).Font.Bold = True
'(123)將工作表Sheet1中的行1隱藏
      ThisWorkbook.Worksheets("Sheet1").Rows(1).Hidden = True
      '將當前工作表中活動單元格所在的行隱藏
      ActiveCell.EntireRow.Hidden = True
'      註：同樣可用於列。
'(124)自動調整當前工作表A列列寬
      ActiveSheet.Range("A:A").EntireColumn.AutoFit
'(125)選中當前工作表中常量和文本單元格
      ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlTextValues)
      '選中當前工作表中常量和文本及錯誤值單元格
      ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlErrors+xlTextValues)
'*******************************************************
'      公式與函數
'(126)將自定義的SumPro函數指定給Excel中的"統計函數"類別
      Application.MacroOptions Macro:="SumPro", Category:=4
'(127)為自定義函數SumPro進行了功能說明
       Application.MacroOptions Macro:="SumPro", _
               Description:="First Sum,then Product"
'(128)獲取A列的下一個空單元格
      Application.WorksheetFunction.CountA (Range("A:A")) + 1
'(129)返回該單元格所在列非空單元格的數量
      WorksheetFunction.CountA (Cell.EntireColumn)
      '返回該單元格所在行非空單元格的數量
      WorksheetFunction.CountA (Cell.EntireRow)
'(130)返回工作表中非空單元格數量
      WorksheetFunction.CountA (Cells)
'(131)對A列至D列前19個數值求和
       ActiveSheet.Range("A20:D20").Formula = "=Sum(R[-19]C:R[-1]C"
'*******************************************************
'      圖表
'(132)使圖表處於非活動狀態
       ActiveWindow.Visible = False
      '或
       ActiveChart.Deselect
'(133)若選中的為圖表，則該語句為真，否則為假
      TypeName(Selection) = "Chart"
'(134)刪除工作表上所有的ChartObject對象
      ActiveSheet.ChartObjects.Delete
      '刪除當前工作簿中所有的圖表工作表
        ActiveWorkbook.Charts.Delete
'*******************************************************
'      窗體和控件
'(135)添加用戶窗體MyForm並顯示
      UserForms.Add(MyForm).Show
'(136)設置文本框獲取輸入焦點
      TextName.SetFocus
'(137)將數值調節鈕控件的值改為0
      SpinButton1.Value = 0
'(138)將數值調節鈕控件的值賦值給文本框控件
      TextBox1.Text = SpinButton1.Value
      '將文本框控件值賦給數值調節鈕控件
      SpinButton1.Value = "/Val(TextBox1.Text)"
      '數值調節鈕控件和文本框控件相比較
      CStr(SpinButton1.Value)=TextBox1.Text
'(139)顯示窗體UserForm1上的控件數目
      UserForm1.Controls.Count
'(140)在列表框中添加Command1
      ListBox1.AddItem "Command1"
'(141)返回列表框中條目的值，若為-1，則表明未選中任何列表框中的條目
      ListBox1.ListIndex
'(142)返回代表單元格區域地址的文本字符串
      RefEdit1.Text
      '初始化RefEdit控件顯示當前所選單元格區域
      RefEdit1.Text = ActiveWindow.RangeSelection.Address
      '設置某單元格區域左上角單元格
      Set FirstCell = Range(RefEdit1.Text).Range("A1")
'(143)等待15秒後運行myProcedure過程
      Application.OnTime Now + TimeValue("00:00:15"), "myProcedure"
'(144)將滾動條控件的值賦值給ActiveWindow對象的ScrollColumn屬性
      ActiveWindow.ScrollColumn = ScrollBarColumns.Value
      '將滾動條控件的值賦值給ActiveWindow對象的ScrollRow屬性
      ActiveWindow.ScrollRow = ScrollBarRows.Value
'(145)將單元格A1中的數據添加到列表框中
      UserForm1.ListBox1.AddItem Sheets("Sheet1").Cells(1, 1)
      '將一個名為Product數組的值添加到ListBox1中
      ListBox1.List = Product
      '使用工作表Sheet2中的SumP區域的值填充列表框
      ListBox1.RowSource = "Sheet2!SumP"
'(146)選中列表框中的第一個條目(註：當列表框允許一次選中多個條目時，必須使用Selected屬性)
      ListBox1.Selected (0)
'(147)移除列表框中選中的條目
      ListBox1.RemoveItem ListBox1.ListIndex
'*******************************************************
'      對象
'      Application對象
'(148)返回應用程序的用戶名
      Application.UserName
'(149)返回代表調用函數的單元格
      Application.Caller
'(150)返回調用函數的工作簿名稱
      Application.Caller.Parent.Parent
'(151)將文本寫到狀態欄
      Application.StatusBar = "請等待……"
      '更新狀態欄文本，以變量Percent代表完成的百分比
      Application.StatusBar = "請等待……" & Percent & "% Completed"
      '將狀態欄重新設置成正常狀態
      Application.StatusBar = False
'(152)指定單元格區域A1至D4，等同於選擇"編輯——定位"，指定單元格區域為A1至D4，不會出現"定位"對話框
      Application.Goto Reference:=Range("A1:D4")
'(153)顯示"定位"對話框，但定位條件按鈕無效
      Application.Dialogs(xlDialogFormulaGoto).Show
'(154)顯示"定位條件"對話框
      Application.Dialogs(xlDialogSelectSpecial).Show
'(155)顯示"單元格格式"中的"數字"選項卡
      Application.Dialogs(xlDialogFormatNumber).Show
      '顯示"單元格格式"中的"對齊"選項卡
      Application.Dialogs(xlDialogAlignment).Show
      '顯示"單元格格式"中的"字體"選項卡
      Application.Dialogs(xlDialogFontProperties).Show
      '顯示"單元格格式"中的"邊框"選項卡
      Application.Dialogs(xlDialogBorder).Show
      '顯示"單元格格式"中的"圖案"選項卡
      Application.Dialogs(xlDialogPatterns).Show
      '顯示"單元格格式"中的"保護"選項卡
      Application.Dialogs(xlDialogCellProtection).Show
'      註：無法一次顯示帶選項卡的"單元格格式"對話框，只能一次顯示一個選項卡。
'(156)顯示"引用位置"的默認單元格區域並顯示引用使其出現在窗口左上角(註：內置對話框參數的使用)
      Application.Dialogs(xlDialogFormulaGoto).Show Range("b2"), True
'(157)執行"定位"話框，相當於選擇菜單"編輯——定位"命令
      Application.CommandBars(1).Controls(2).Controls(16).Execute
'(158)返回一個垂直的數組
      Application.Transpose (Array("Sun", "Mon", "Tur", "Wed", "Thu", "Fri", "Sat"))
'(159)返回使用的Excel版本號
      Application.Version
'(160)設置光標形狀為北西向箭頭
      Application.Cursor = xlNorthwestArrow
      '設置光標形狀為Ⅰ字形
      Application.Cursor = xlIBeam
      '設置光標形狀為沙漏(等待)形
      Application.Cursor = xlWait
      '恢復光標的默認設置
      Application.Cursor = xlDefault
'(161)返回窗口當前的狀態
      Application.WindowState
      '窗口最小化
      Application.WindowState = xlMinimized
      '窗口最大化
      Application.WindowState = xlMaximized
      '窗口正常狀態
      Application.WindowState = xlNormal
'(162)獲取當前窗口的高度
      Application.UsableHeight
      '獲取當前窗口的寬度
      Application.UsableWidth
'(163)返回活動單元格的地址(註:返回的是絕對地址)
      Application.ActiveCell.Address
'(164)返回當前打印機的名稱
      Application.ActivePrinter
'(165)返回活動工作表的名稱
      Application.ActiveSheet.Name
'(166)返回活動窗口的標題
      Application.ActiveWindow.Caption
'(167)返回活動工作簿的名稱
      Application.ActiveWorkbook.Name
'(168)返回所選區域的地址
      Application.Selection.Address
'(169)返回當前工作簿的名稱
      Application.ThisWorkbook.Name
'(170)返回Excel計算引擎版本(右邊四位數字)及Excel版本(左邊兩位數字)
      Application.CalculationVersion
'(171)以字節為單位返回Excel允許使用的內存數(不包括已經使用的內存)
      Application.MemoryFree
'(172)以字節為單位返回Excel當前使用的內存數
      Application.MemoryUsed
'(173)以字節為單位返回Excel可以使用的內存數(包括已使用的內存,是MemoryFree和MemoryUsed的總和)
      Application.MemoryTotal
'(174)返回所使用的操作系統的名稱和版本
      Application.OperatingSystem
'(175)返回Excel產品登記使用的組織機構的名稱
      Application.OrganizationName
'(176)查找的格式種類
      Application.FindFormat
      '替換查找到的內容的格式種類
      Application.ReplaceFormat
      '替換查找到的格式
       ActiveSheet.Cells.Replace What:=" ", _
               Replacement:=" ", SearchFormat:=True, ReplaceFormat:=True
'(177)忽略鍵盤或鼠標的輸入
      Application.Interactive = False
'(178)若在工作表中定義了常量0.06的名稱為"Rate",則本語句將返回值0.06
      Application.Evaluate ("Rate")
'(179)選擇UndoOption後，將執行Undo Procedure過程
      Application.OnUndo "Undo Option", "Undo Procedure"
'*******************************************************
'      Range對象
'(180)將一個含有10個元素的數組轉置成垂直方向的工作表單元格區域(A1至A10)
      Range(A1:A10).value="/Application.WorksheetFunction.Transpose(MyArray)"
'      註：因為當把一維數組的內容傳遞給某個單元格區域時，該單元格區域中的單元格必須是水平方向的，即含有多列的一行。若必須使用垂直方向的單元格區域，則必須先將數組進行轉置，成為垂直的。
'(181)返回A列最後一行的下一行
      Range("A65536").End(xlUp).Row 1
'(182)返回區域左上角的單元格
      rng.Range ("A1")
'(183)訪問當前單元格所在的工作簿
      Cell.Parent.Parent.Worksheets
'(184)切換所選單元格是否加粗
      Selection.Font.Bold = Not Selection.Font.Bold
'(185)兩個關鍵字排序，相鄰兩列，B列為主關鍵字，A列為次關鍵字，升序排列
       ActiveSheet.Range("A:B").Sort Key1:=Columns("B"), Key2:=Columns("A"), _
               Header:=xlYes
'(186)顯示單元格或單元格區域中的第一個單元格的數字格式
      Cell.Range("A1").NumberFormat
'(187)檢查單元格或單元格區域中的第一個單元格是否含有公式
      Cell.Range("A1").HasFormula
      '工作表中單元格是否含有公式
      或cell.HasFormula
'(188)單元格所在的整列
      Cell.EntireColumn
      '單元格所在的整行
         Cell.EntireRow
'(189)顯示rng區域的名稱
      rng.Name.Name
'(190)返回rng區域的地址
      rng.Address
'(191)返回包含在rng區域中左上角單元格中的公式。
      Cell.Range("A1").Formula
'      註：若在一個由多個單元格組成的範圍內使用Formula屬性，會得到錯誤；若單元格中沒有公式，會得到一個字符串，在公式欄中顯示該單元格的值。
'(192)返回單元格區域D5:D10中左上角單元格
      Range("D5:D10").Cells(1,1)
'(193)活動單元格所在的行數
      ActiveCell.Row
      '活動單元格所在的列數
         ActiveCell.Column
'(194)當前工作表中的單元格區域數據設置為左對齊
      Range("A1:B1").HorizontalAlignment = xlLeft
'(195)設置單元格區域A2至A10中數值格式
      ActiveSheet.Range("A2:A10").NumberFormat = "#,##0"
'(196)用0替換單元格區域中的空單元格
      rng.Replace " ", "0"
'*******************************************************
'      Collection與object
'(197)
       Dim colMySheets As New Collection
      '聲明新的集合變量
      Public colMySheets As New Collection
'(198)創建一個名為MyRange的對象變量
      Set MyRange = Range("A1:A5")
'(199)向集合中添加惟一的條目(即將重複的條目忽略)
      objColl.Add Cell.Value, CStr(Cell.Value)
'*******************************************************
'      Windows API
'(200)API函數聲明。
       '返回安裝Windows所在的目錄名稱，調用該函數後，安裝Windows的目錄名稱將在第一個參數lpBuffer中，該目錄名稱的字符串長度包含在第二個參數nSize中
       Declare Function GetWindowsDirectoryA Lib "kernel32" (ByVal lpBuffer As String, ByVal nSize As Long) As Long