VBA——基础知识

**

第二章、第三章

**

• 宏的两种录制模式——相对引用和绝对引用
• 表单控制组和命令控件
  表单控件是为电子表格专门设计的，ActiveX控件是为Excel的用户窗体设计的。
• VBE组件：菜单栏，工具栏，工程资源管理器，属性窗口，代码窗口，立即窗口。
• 空格+下划线表换行
• Application对象是包罗万象的对象。
• 对象，属性，方法。

一行一条指令
空格加下划线=换行

在运算符之间插入空格

VBA变量名称不区分大小写，且有后来者居上的道理。myvalue  ->MyValue

工具、选项、编辑、编辑器，建议全选。

关于注释：
1、'
2、"can't help"  双引号里面的不会被当做注释
3、Rem (remark) = '
4、视图-工具栏-编辑-解除注释块

！变量命名规则
1、开头必须是字母，字母数字下划线
2、长度0~255

！数据类型
byte 0~255
decimal   是 varirant的子类型。
不失精度——double
int <132 7671 但建议用 long ,运行快。
typename()——显示数据类型。

！声明数据变量的好处：
1、更快更有效地使用内存
2、避免出现与错误拼写变量名称有关的问题

强制声明所有变量：
option explicit  

dim /static
dim / private
public

End语句 不同于 End Sub语句

Dim MyValue  #只声明了变量，没有声明数据类型，默认为Variant
Dim i,j,k as Interger  只能k为Interger数据类型
Dim i as interger ,j as  interger 

局部变量最高效，使用完释放内存。
当VBA遇到End语句，所有模块作用域下面的变量都失去它们的值。

static 静态变量
在过程结束时，变量的值不丢失。
但在遇到End语句时丢失。

常量 Const
某过程常量
某模块常量
全模块常量

预定义常量，在VBA中已经被声明了的变量。

字符串：
定长字符串  Dim Mystring as string *50 (最大长度为50)
变长字符串  Dim Mystring as string  6 5535

在VBA中，指定日期和时间使用  #时间#
Dim starttime as date
starttime = #2019/1/1#

\ 整数
mod  余数

VBA  数组默认从0开始
Dim  MyArray (1 to 100) as integer = 在模块的任意过程之前 **option Base 1**
Dim MyArray (1 to 100, 1 to 100, 1 to 100) as Integer
MyArray(4,8,2)=0

动态数组
Dim MyArray() as Integer
ReDim MyArray(1 to x)

对象变量Range (set 把对象赋给变量)
Dim inputarea as range
set inputarea = Range("C16:E16")

worksheets("sheet1").range("A1").Value = 124
worksheets("sheet1").range("A1").Font.Bold = True

Dim MyCell as  Range 
set MyCell = worksheets("sheet1").range("A1")
MyCell.value =124
MyCell.Font.Bold = True

查看VBA内置函数：
VBA.

VBA函数与工作簿函数：
1、VBA有，工作簿没有。
2、VBA有，工作簿有。——不能使用等价函数，只能使用VBA函数，否则报错。
3、VBA没有，工作簿有。——在函数名称加上**Application.WorksheetFunction.**函数名（）
	  例：romanvalue = Application.WorksheetFunction.Roman(1939)

不失精度——Double
Long（4字节）比Int（2字节）
variant(16字节）（万能数据类型）：可保存数值和字符串。像Empty，Error，Nothing，NULL特殊数值也可保存。精度上面可保存到双精度数据类型的任意数值。

第四章

• 执行：
  当在VBA时，F5 + Alt+R
  当在工作簿时，Alt+F8 + Alt+R

• 设置快捷键执行过程
  快捷键区分大小写 如：Ctrl+s Ctrl+Shift+s(大写S)
  自定义快捷键的优先级高于Excel预定义的快捷键优先级

• option explicit 所有变量要声明数据类型。
  option private module 该模块的所有过程都是私有的，在第一个sub语句之前。
  

• 同一个模块中不可以有同名过程
  两个模块中可以有同名过程
  在调用时 加上模块名称，call moudule1.mysub

• 引用另一个.xlsm文件
  方法1 ：在vba中 工具 引用，不必打开.xlsm文件，可视为单独的对象库。
  VBA中代码：Call YourProject.YourModule.YourSub
  方法2：
  无需建立引用，只需打开要调用的.xlsm文件
  VBA中代码：application.Run " ‘budget macros.xlsm’!Consolidate" 位于budget的macros.slsm工作簿中的Consolidate过程。

• 可以把宏给 形状、smartart、艺术字、图片、或者嵌入图表。

Sub main()
      Dim subtocall As String
      MsgBox (Weekday(Now))
      Select Case Weekday(Now)
            Case 1, 7: subtocall = "WeekEnd"
            Case Else: subtocall = "Daily"
      End Select
            Application.Run subtocall
End Sub

Sub WeekEnd()
      MsgBox ("Today is a weekend")
End Sub

Sub Daily()
      MsgBox ("Today is a weekday")
End Sub

代码放在哪都行的，都可以在整个工作簿中调用运行。只不过由于存放位置不同，当我们在存放地点之外调用时，调用的方法有所不同而已：
1、如果在存放地调用，都是直接用函数或过程名称调用就可以了；
2、如果在存放地之外调用，那就有一点不同：
1）、如果存放在模块中，可以直接用函数或过程名称调用；
2）、如果存放在sheet或ThisWorkbook中，则必须在用函数或过程名称前明确指出它们的存放地，如sheet1.ab、ThisWorkbook.vhf；
不过一般来说为了规范，我们习惯把自定义的函数和过程放在模块中，但并不是说必须这么做；
可是工作表或工作簿事件则必须放在sheet或ThisWorkbook中。

第六章、事件

禁用（启用）所有事件
禁用所用事件后，但不会影响到 由UserForm控件所触发的事件。

Application.EnableEvents = False '禁用所有事件
Application.EnableEvents = True '启用所有事件

- activate事件——监控是否打开了工作薄事件，如果打开了工作薄窗口最大化。

• sheetactive事件——在用户激活工作薄的任意工作表时执行。如果是一个工作表，则会选择单元格A1。

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    'If TypeName(Sh) = "Worksheet" Then Range("A4").Select
    On Error Resume Next
    Range("A5").Select
End Sub

• NewSheet事件——向工作薄中添加一个新工作表时执行下操作。

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    If TypeName(Sh) = "Worksheet" Then
        Sh.Cells.ColumnWidth = 35
        Sh.Range("A1") = "Sheet added " & Now()
End Sub

• BeforeSave事件——在实际保存工作薄中（即文件另存为）之前发生，提示你：Make sure you save this file on drive
  J

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If SaveAsUI Then
        MsgBox "Make sure you save this file on drive J ."
    End If
End Sub

• Deactivate事件——在关闭当前的活动工作薄或者打开一个新的工作薄时都会提示你：Sorry, you may not leave this workbook

Private Sub Workbook_Deactivate()
    Me.Activate
    MsgBox "Sorry, you may not leave this workbook"
End Sub

- BeforePrint事件——在打印前执行的过程
下面是在打印前设置左页脚为“sheet1”的A1表格的值

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim sht As Object
    For Each sht In ThisWorkbook.Sheets
        sht.PageSetup.LeftFooter = _
        Worksheets("Sheet1").Range("A1")
    Next sht
End Sub

运行失败，目的原为：预览五秒后，隐藏B：D列。

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    'hide columns B:D on sheet1 before printing
    Worksheets("Sheet1").Range("B:D").EntireColumn.Hidden = True
    Application.OnTime Now() + TimeValue("0:00:05"), "UnhideColumns"
End Sub

Sub UnhideColumns()
    Worksheets("sheet1").Range("B:D").EntireColumn.Hidden = False
End Sub

Workbook_SheetChange事件——监控sheet表是否有修改动作。 Workbook_SheetSelectionChange——监控选择的区域是否有修改动作。

缺点：用change事件来监控并不可靠。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    MsgBox "Range " & Target.Address & " was changed . "
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    MsgBox "Range " & Target.Address & " was changed . "
End Sub

监控特定的单元格（G14）是否有修改

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Mrange As Range
    Set Mrange = Range("A1:A10")
    If Not Intersect(Target, Mrange) Is Nothing Then _
        MsgBox "A changed cell is in the input range."
End Sub

Intersect函数来确定Target单元格区域是否与Mrange单元格区域相交叉，返回Nothing 或者 TRUE

监控所有sheets表，如果有单元格里面有公式就加粗。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim cell As Range
    For Each cell In Target
        If cell.HasFormula Then cell.Font.Bold = True
    Next
End Sub

缺点：如果用户删除一行

监测单元格区域的数字有效性

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Vrange As Range, cell As Range
    Dim Msg As String
    Dim ValidateCode As Variant
    
    Set Vrange = Range("A1:A10")
    
    If Intersect(Vrange, Target) Is Nothing Then Exit Sub
    For Each cell In Intersect(Vrange, Target)
        ValidateCode = EntryIsValid(cell)
        If TypeName(ValidateCode) = "string" Then
            Msg = "Cell " & cell.Address(False, False) & " : "
            Msg = Msg & vbCrLf & ValidateCode
            MsgBox Msg, vbCritical, "Invalid Entry"
            Application.EnableEvents = False
            cell.ClearContents
            cell.Activate
            Application.EnableEvents = True
        End If
    Next cell
End Sub

Private Function EntryIsValid(cell) As Variant
    If Not WorksheetFunction.IsNumber(cell) Then
        EntryIsValid = "Integer required"
        Exit Function
    End If
    
    If CInt(cell) <> cell Then
        EntryIsValid = "Integer required . "
        Exit Function
    End If

    If cell < 1 Or cell > 12 Then
        entryValid = "Valid values are between 1 and 12 ."
        Exit Function
    End If
    
    EntryIsValid = True
End Function

Set Vrange = Range(“A1:A10”)

---

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim VT As Long
    On Error Resume Next
    VT = Range("A1:A10").Validation.Type
    If Err.Number <> 0 Then
        Application.Undo
        MsgBox "Your last operation was canceled ." & _
        "It would have deleted data validation rules .", vbCritical
    End If
End Sub

SelectionChange事件——十字高亮

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Cells.Interior.ColorIndex = xlNone
    With ActiveCell
        .EntireRow.Interior.Color = RGB(219, 229, 241)
        .EntireColumn.Interior.Color = RGB(219, 229, 241)
    End With
End Sub

BeforeDoubleClick——用户在双击单元格时使用

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.Style = "Good" Then
        Target.Style = "Normal"
    Else
        Target.Style = "Good"
    End If
    Cancel = True
End Sub

SheetBeforeRightClick——单击右键之前，禁止单击右键

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    MsgBox "The shortcut menu is not available."
End Sub

shift+F10=右击

在含有数字的单元格中，只要单击右击就会出现格式设置。

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If IsNumeric(Target) And Not IsEmpty(Target) Then
        Application.CommandBars.ExecuteMso ("NumberFormatsDialog")
        Cancel = True
    End If
End Sub

监控应用程序事件

类模块clsApp

Public WithEvents AppEvents As Application

Private Sub appevents_workbookopen(ByVal Wb As Excel.Workbook)
    Call updateLogfile(Wb)
End Sub

模块

Dim AppObject As New clsApp

Sub Init()
    Set AppObject.AppEvents = Application
End Sub

Sub updateLogfile(Wb)
    Dim txt As String
    Dim Fname As String
    txt = Wb.FullName
    txt = txt & ", " & Date & ", " & Time
    txt = txt & ", " & Application.UserName
    Fname = Application.DefaultFilePath & "\logfile.csv"
    Open Fname For Append As #1
    Print #1, txt
    Close #1
    MsgBox txt
End Sub

ThisWorkBook

Private Sub workbook_open()
    Call Init
End Sub

访问与对象无关联的事件
前面所讨论的事件都是与某个对象（Application、Workbook、和Sheet等）关联。OnTime和OnKey这两个事件与对象无关联。

OnTime事件是在一天中的某特定时刻发生。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopClock
End Sub

Dim NextTick As Date
  
Sub UpdateClock()
    'Updates cell A1 with current time
    ThisWorkbook.Sheets(1).Range("A1") = Time
    'Set up the next event five seconds from now
    NextTick = Now + TimeValue("00:00:05")
    Application.OnTime NextTick, "UpdateClock"
End Sub

Sub StopClock()
    'Cancles the Ontime event (stops the clock)
    On Error Resume Next
    Application.OnTime NextTick, "UpdateClock", , False
End Sub

禁用右击和禁用shift+F10

Sub SetupNoshiftF10()
    Application.OnKey "+{F10}", "NoShiftF10"
End Sub

Sub TurnoffNoShiftF10()
    Application.OnKey "+{F10}"
End Sub

Sub NoshiftF10()
    MsgBox "nice Try, but that doesn't work either"
End Sub