2011年11月18日星期五

實用VBA語句集(第1輯)


'定製模塊行為
'(1)強制對模塊內所有變量進行聲明
      Option Explicit
      '標記模塊為私有,僅對同一工程中其它模塊有用,在宏對話框中不顯示
      Option Private Module
      '字符串不區分大小寫
      Option Compare Text
      '指定數組的第一個下標為1
      Option Base 1
'(2)忽略錯誤繼續執行VBA代碼,避免出現錯誤消息
      On Error Resume Next
'(3)當錯誤發生時跳轉到過程中的某個位置
      On Error GoTo ErrorHandler
'(4)恢復正常的錯誤提示
      On Error GoTo 0
'(5)在程序執行過程中使出現的警告框不顯示
      Application.DisplayAlerts = False
'(6)關閉屏幕刷新
      Application.ScreenUpdating = False
      '打開屏幕刷新
      Application.ScreenUpdating = True
'(7)禁用Ctrl+Break中止宏運行的功能
      Application.Enable.CancelKey = xlDisabled
'
'工作簿
'(8)創建一個新的工作簿
      Workbooks.Add()
'(9)激活名為book1的工作簿
      Workbooks("book1.xls").Activate
'(10)保存工作簿
      ThisWorkbook.Save
'(11)關閉當前工作簿
      ThisWorkbook.Close
'(12)獲取活動工作薄中工作表數
      ActiveWorkbook.Sheets.Count
'(13)返回活動工作薄的名稱
      ActiveWorkbook.Name
'(14)返回當前工作簿名稱
      ThisWorkbook.Name
      '返回當前工作簿路徑和名稱
      ThisWorkbook.FullName
'(15)禁止調整活動工作簿的大小
      ActiveWindow.EnableResize = False
'(16)將工作簿以平鋪方式排列
      Application.Window.Arrange xlArrangeStyleTiled
'(17)將當前工作簿最大化
      ActiveWorkbook.WindowState = xlMaximized
'
'工作表
'(18)當前工作表中已使用的行數
      ActiveSheet.UsedRange.Rows.Count
'(19)獲取工作表的行數(註:考慮向前兼容性)
      Rows.Count
'(20)將Sheet1命名為Sum
      Sheets(Sheet1).Name = "Sum"
'(21)添加一個新工作表在第一工作表前
      ThisWorkbook.Sheets.Add Before:=Worksheets(1)
'(22)將當前工作表移至工作表的最後
      ActiveSheet.Move After:=ActiveWorkbook. _
           Sheets(ActiveWorkbook.Sheets.Count)
'(23)同時選擇工作表1和工作表2
      Worksheets(Array("sheet1", "sheet2")).Select
'(24)刪除工作表1
      Sheets("sheet1").Delete
      '或
      Sheets(1).Delete
'(25)獲取工作表i的名稱
      ActiveWorkbook.Sheets(i).Name
'(26)切換工作表中的網格線顯示,這種方法也可以用在其它方面進行相互切換,即相當於開關按鈕
      ActiveWindow.DisplayGridlines = Not ActiveWindow.DisplayGridlines
'(27)切換工作表中的行列邊框顯示
      ActiveWindow.DisplayHeadings = Not ActiveWindow.DisplayHeadings
'(28)刪除當前工作表中所有的條件格式
      ActiveSheet.UsedRange.FormatConditions.Delete
'(29)取消當前工作表所有超鏈接
      Cells.Hyperlinks.Delete
'(30)將頁面設置更改為橫向
      ActiveSheet.PageSetup.Orientation = xlLandscape
      '或
      ActiveSheet.PageSetup.Orientation = 2
'(31)在頁面設置的表尾中輸入文件路徑
      ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName
      '將用戶名放置在活動工作表的頁腳
      ActiveSheet.PageSetup.LeftFooter = Application.UserName
'
'單元格/單元格區域
'(32)選擇當前活動單元格所包含的範圍,上下左右無空行
      ActiveCell.CurrentRegion.Select
      '或
      Range(ActiveCell.End(xlUp), ActiveCell.End(xlDown)).Select
'(33)選定當前工作表的所有單元格
      Cells.Select
'(34)清除活動工作表上單元格A1中的內容
      Range("A1").ClearContents
      '清除選定區域內容
      Selection.ClearContents
      '徹底清除A1至D4單元格區域的內容,包括格式
      Range("A1:D4").Clear
'(35)清除工作表中所有單元格的內容
      Cells.Clear
'(36)活動單元格下移一行,同理,可下移一列
      ActiveCell.Offset(1, 0).Select
'(37)偏移一列
      Range("A1").Offset(ColumnOffset:=1)
      '或
      Range("A1").Offset(,1)
      '向上偏移一行
      Range("A1").Offset(Rowoffset:=-1)
      '或
      Range("A1").Offset (-1)
'(38)複製單元格A1,粘貼到單元格B1中
      Range("A1").Copy Range("B1")
      '將單元格區域複製到單元格F1開始的區域中
      Range("A1:D8").Copy Range("F1")
      '剪切單元格區域A1至D8,複製到單元格F1開始的區域中
      Range("A1:D8").Cut Range("F1")
      '複製包含A1的單元格區域到工作表2中以A1起始的單元格區域中
      Range("A1").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
'註:CurrentRegion屬性等價於定位命令,由一個矩形單元格塊組成,周圍是一個或多個空行或列
'(39)將值XX輸入到所選單元格區域中
      ActiveWindow.RangeSelection.Value = XX
'(40)活動窗口中選擇的單元格數
      ActiveWindow.RangeSelection.Count
'(41)當前選中區域的單元格數
      Selection.Count
'(42)返回單元格中超級鏈接的地址並賦值
      GetAddress = Replace(Hyperlinkcell.Hyperlinks(1).Address, "mailto:", "")
'(43)檢查單元格A1的文本顏色並返回顏色索引
      TextColor = Range("A1").Font.ColorIndex
      '獲取單元格A1背景色
      Range("A1").Interior.ColorIndex
'(44)返回當前工作表的單元格數
      Cells.Count
'(45)激活當前活動單元格下方3行,向右4列的單元格
      Selection.Range("E4").Select
'(46)引單元格C5
      Cells.Item(5,"C")
      '引單元格C5
      Cells.Item(5,3)
'(47)指定單元格F5
      Range("A1").Offset(RowOffset:=4,ColumnOffset:=5)
      '或
      Range("A1").Offset(4, 5)
'(48)創建B3:D13區域
      Range("B3").Resize(RowSize:=11,ColumnSize:=3)
      Rnage("B3").Resize(11,3)
'(49)將Data區域擴充2列
      Range("Data").Resize(,2)
'(50)將Data1和Data2區域連接
      Union(Range("Data1"),Range("Data2"))
'(51)返回Data1和Data2區域的交叉區域
      Intersect(Range("Data1"),Range("Data2"))
'(52)單元格區域Data中的單元格數
      Range("Data").Count
      '單元格區域Data中的列數
      Range("Data").Columns.Count
      '單元格區域Data中的行數
      Range("Data").Rows.Count
'(53)當前選中的單元格區域中的列數
      Selection.Columns.Count
      '當前選中的單元格區域中的行數
      Selection.Rows.Count
'(54)選中的單元格區域所包含的區域數
      Selection.Areas.Count
'(55)獲取單元格區域中使用的第一行的行號
      ActiveSheet.UsedRange.Row
'(56)獲取單元格區域Rng左上角單元格所在列編號
      Rng.Column
'(57)在活動工作表中返回所有符合條件格式設置的區域
      ActiveSheet.Cells.SpecialCells (xlCellTypeAllFormatConditions)
'(58)關閉由於執行自動篩選命令產生的第3個字段的下拉列表
      Range("A1").AutoFilter Field:=3, VisibleDropDown:=False
'
'名稱
'(59)命名A1:C3區域為computer
      Range("A1:C3").Name = "computer"
      '命名局部變量,即Sheet1上區域D1:E6為book
      '或
      Range("D1:E6").Name = "Sheet1!book"
      '將區域computer重命名為robot
      '或
      Names("computer").Name = "robot"
'(60)刪除名稱
      Names("book").Delete
'(61)動態命名列
      Names.Add Name:="ContentList", _
                RefersTo:="=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))"
'(62)命名字符串CompanyCar
      Names.Add Name:="Company", RefersTo:="CompanyCar"
'(63)將數字123456命名為Total。注意數字不能加引號,否則就是命名字符串了。
      Names.Add Name:="Total", RefersTo:=123456
'(64)將數組ArrayNum命名為MyArray。
      Names.Add Name:="MyArray", RefersTo:=ArrayNum
'(65)將名稱隱藏
      Names.Add Name:="ProduceNum", RefersTo:="=$B$1", Visible:=False
'(66)返回名稱字符串
      ActiveWorkbook.Names("Com").Name
'
'公式與函數
'(67)使用工作表函數檢查A1單元格中的數據是否為數字
      Application.WorksheetFunction.IsNumber ("A1")
'(68)
      Range("A:A").Find(Application.WorksheetFunction.Max(Range("A:A"))).Activate
      '激活單元格區域A列中最大值的單元格
   
'(69)在單元格中輸入數組公式。注意必須使用R1C1樣式的表達式
      Cells(8, 8).FormulaArray = "=SUM(R2C[-1]:R[-1]C[-1]*R2C:R[-1]C)"
'
'圖表
'(70)獲取當前工作表中圖表的個數
      ActiveSheet.ChartObjects.Count
'(71)選中當前工作表中圖表Chart1
      ActiveSheet.ChartObjects("Chart1").Select
'(72)
      ActiveSheet.ChartObjects("Chart1").Activate
      '選中當前圖表區域
      ActiveChart.ChartArea.Select
'(73)更改工作表中圖表的圖表區的顏色
      Worksheets("Sheet1").ChartObjects("Chart2").Chart. _
              ChartArea.Interior.ColorIndex = 2
'(74)更改圖表工作表中圖表區的顏色
      Sheets("Chart2").ChartArea.Interior.ColorIndex = 2
'(75)添加新的圖表工作表
      Charts.Add
'(76)指定圖表數據源並按列排列
      ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1:D5"), _
              PlotBy:=xlColumns
'(77)新圖表作為新圖表工作表
      ActiveChart.Location Where:=xlLocationAsNewSheet
'(78)將繪圖區顏色變為白色
      ActiveChart.PlotArea.Interior.ColorIndex = xlNone
'(79)將圖表1導出到C盤上並命名為MyChart.gif
      Worksheets("Sheet1").ChartObjects(1).Chart. _
                Export Filename:="C:MyChart.gif", FilterName:="GIF"
'
'窗體
'(80)消息框中顯示消息Hello
      MsgBox "Hello!"
'(81)在消息框中點擊"是"按鈕,則Ans值為vbYes;點擊"否"按鈕,則Ans值為vbNo。
      Ans = MsgBox("Continue?", vbYesNo)
      '返回值不為"是",則退出
      If MsgBox("Continue?", vbYesNo) <> vbYes Then Exit Sub
'(82)使用常量的組合,賦值組Config變量,並設置第二個按鈕為缺省按鈕
      Config = vbYesNo + vbQuestion + vbDefaultButton2
'(83)在消息框中強制換行,可用vbCrLf代替vbNewLine。
      MsgBox "This is the first line." & vbNewLine & "Second line."
'(84)應用工作表函數返回所選區域的平均值並按指定格式顯示
      MsgBox "the average is :" & _
       Format(Application.WorksheetFunction.Average(Selection), "#,##0.00"), vbInformation, "selection count average" & Chr(13)
'(85)顯示用戶窗體
      UserForm1.Show
'(86)加載一個用戶窗體,但該窗體處於隱藏狀態
      Load UserForm1
'(87)隱藏用戶窗體
      UserForm1.Hide
'(88)卸載用戶窗體
      Unload UserForm1
      '或
      Unload Me
'(89)在用戶窗體中顯示圖形
      Picture1.Picture = LoadPicture("C:\1.JPG")
'(90)將窗體設置為無模式狀態
      UserForm1.Show 0
      '或
      UserForm1.Show vbModeless
'(91)窗體高度為當前活動窗口高度的0.88
      Me.Height = Int(0.88 * ActiveWindow.Height)
      '窗體寬度為當前活動窗口高度的0.88
      Me.Width = Int(0.88 * ActiveWindow.Width)
'
'事件
'(92)禁用所有事件
      Application.EnableEvents = False
      '啟用所有事件
      Application.EnableEvents = True
'註:不適用於用戶窗體控件觸發的事件
'對象
'(93)創建一個Excel工作表對象
      Set ExcelSheet = CreateObject("Excel.Sheet")
      '設置 Application 對象使 Excel 可見
      ExcelSheet.Application.Visible = True
      '在表格的第一個單元中輸入文本
      ExcelSheet.Application.Cells(1, 1).Value = "Data"
      '將該表格保存到C:\test.xls 目錄
      ExcelSheet.SaveAs "C:\TEST.XLS"
      '關閉 Excel
      ExcelSheet.Application.Quit
      '釋放該對象變量
      Set ExcelSheet = Nothing
'(94)聲明並創建一個Excel對象引用
      Dim xlApp As Excel.Application
      Dim xlBook As Excel.Workbook
      Dim xlSheet As Excel.Worksheet
      Set xlApp = CreateObject("Excel.Application")
      Set xlBook = xlApp.Workbooks.Add
      Set xlSheet = xlBook.Worksheets(1)
'(95)創建並傳遞一個 Excel.Application 對象的引用
      Call MySub(CreateObject("Excel.Application"))
'(96)創建一個 Dictionary 對象變量
      Set d = CreateObject(Scripting.Dictionary)
'(97)為對象變量添加關鍵字和條目
      d.Add "a", "Athens"
'
'其他
'(98)設置Ctrl+I鍵為macro過程的快捷鍵
      Application.OnKey "^I", "macro"
'(99)退出剪切/複製模式
      Application.CutCopyMode = False
'(100)無論何時工作表中任意單元格重新計算,都會強制計算該函數
      Application.Volatile True
      '只有在該函數的一個或多個參數發生改變時,才會重新計算該函數
      Application.Volatile False

沒有留言:

發佈留言