VBA 简易复习

VBA

工作中偶尔要用到VBA，简单学习一下。

VBA - Visual Basic for Application

VBA Environment in Office

  • 宏(Alt+F8)
    可以录了看看Office自己怎么写的。
  • Visual Basic Editor(Alt+F11)
    IDE。对象浏览器(F2)、立即窗口(Ctrl+G)。
    Debug常用语句：
1
2
3
4
5
6
7
' 代码里
MsgBox LoopIndex & vbNewLine & CellCount & vbNewLine & MyVal
MsgBox ActiveSheet.Name & " " & TypeName(ActiveSheet)
Debug.Print LoopIndex, CellCount, MyVal
' Immidiate Window里
Print CellCount
? CellCount

Office Object Model Help

包括Collections(如Workbooks, Worksheets, Charts, Sheets)和Objects(如Addin, Window, Workbook)。
Events。

  • VBA’s Help System
    F1->搜索按钮右侧箭头->开发人员参考
    Object Model Map
  • The Object Browser。在Visual Basic Editor里按F2。
  • Auto List Members。输入时的自动补全功能。

VBA Language Elements

Sub和Function

区别是Function过程可以返回一个值给调用的过程。

1
2
3
4
5
6
7
8
9
10
11
Sub ShowMessage()
	MsgBox "That's all folks!"
End Sub
Function CubeRoot(number) As Double
	CubeRoot = number ^ (1 / 3)	'返回值需与函数同名
End Function
Sub Test()
	Call ShowMessage()
	Dim Tmp As Double
	Tmp = CubeRoot(2)
End Sub

Image Loading
Image Loading
VBA's Most Useful Built-In Functions

Variables, Constants, and Data Types

1
2
3
4
5
6
7
8
x = 1
InterestRate = 0.075
LoanPayoffAmount = 243089
DataEntered = False
x = x + 1
UserName = "John Doe"
DateStarted = #1/20/2016 12:00:00 AM#
MyNum = YourNum * 1.25

VBA's Built-In Data Types

应当先声明，再定义。

1
2
3
4
5
6
7
8
9
10
11
12
Dim King As String, Kong As Long
Dim Mouthful as Byte
Dim Julian As Boolean
Dim Unmarried As Single
Dim Trouble As Double
Dim WindingRoad As Long
Dim Blind As Date
Public Nuisance
Private FirstClass
Static Cling, Electricity
Dim BaseballCards As New Collection
Dim DentalFloss As String

全局变量。

1
2
3
Public CurrentRate As Long	'全局变量
Static Counter As Integer	'静态变量
Const NumQuarters As Integer = 4	'自定义Const常量

Statements

VBA's Operators
VBA's Logical Operators

Arrays

Declaring arrays

1
2
3
4
5
Dim MyArray (1 To 100) As Integer	// 100 Integers
Dim MyArray (0 To 100) As Integer	// 101 Integers
Dim MyArray (100) As Integer	// 101 Integers
Option Base 1	// Set 1 to be the default lower index
Dim MyArray (100) As Integer	// 100 Integers

Multidimensional arrays

1
2
Dim MyArray (1 To 9, 1 To 9) As Integer
MyArray (3, 4) = 125

Dynamic arrays

1
2
3
Dim MyArray () As Integer
ReDim MyArray (1 To NumElements)	// Destroy old values in array
ReDim Perserve MyArray (1 To NumElements)	// Keep old values in array

Flow Control

Programming Constructs for Making Decisions

GoTo Statement

1
2
3
4
5
6
7
8
9
Sub GoToDemo()
	UserName = InputBox("Enter Your Name: ")
	If UserName <> "Bill Gates" Then GoTo WrongName
	MsgBox ("Welcome Bill...")
	' ...................
	Exit Sub
WrongName:
	MsgBox "Sorry. Only Bill Gates can run this."
End Sub

If-Then Structure

1
2
3
4
5
6
7
8
9
10
11
Sub GreetMe()
	Dim Msg As String
	If Time < 0.5 Then
		Msg = "Morning"
	ElseIf Time >= 0.5 And Time < 0.75 Then
		Msg = "Afternoon"
	Else
		Msg = "Evening"
	End If
	MsgBox "Good " & Msg
End Sub

Select Case Structure

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ShowDiscount()
	Dim Quantity As Integer
	Dim Discount As Double
	Quantity = InputBox("Enter Quantity: ")
	Select Case Quantity
		Case 0 To 24
			Discount = 0.1
		Case 25 To 49
			Discount = 0.15
		Case Is >= 50
			Discount = 0.2
	End Select
	MsgBox "Discount: " & Discount
End Sub

For-Next Loops

1
2
3
4
5
6
7
8
9
10
11
12
Sub ExitForDemo()
	Dim MaxVal As Double
	Dim Row As Long
	MaxVal = WorksheetFunction.Max(Range("A:A"))
	For Row = 1 To Rows.Count Step 1
		If Range("A1").Offset(Row-1, 0).Value = MaxVal Then
			Range("A1").Offset(Row-1, 0).Activate
			MsgBox "Max value is in Row " & Row
			Exit For
		End If
	Next Row	
End Sub

Do-While Loop

1
2
3
4
5
6
Sub DoLoopWhileDemo()
	Do
		ActiveCell.Value = ActiveCell.Value * 2
		ActiveCell.Offset(1, 0).Select
	Loop While ActiveCell.Valud <> Empty
End Sub

Do-Until Loop

1
2
3
4
5
6
Sub DoLoopUntilDemo()
	Do
		ActiveCell.Value = ActiveCell.Value * 2
		ActiveCell.Offset(1, 0).Select
	Loop Until IsEmpty(ActiveCell.Value)
End Sub

Looping Through a Collection

1
2
3
4
5
6
7
8
9
10
Sub ChangeSign()
	Dim Cell As Range
	For Each Cell In Range("A1:E50")
		If Not Cell.HasFormula Then
			If IsNumeric(Cell.Value) Then
				Cell.Value = Cell.Value * -1
			End If
		End If
	Next Cell
End Sub
1
2
3
4
5
6
Sub ChangeCharts()
	Dim Cht As ChartObject
	For Each Cht In Sheets("Sheet1").ChartObjects
		Cht.Chart.ChartType = xlLine
	Next Cht
End Sub

Example

删除 PowerPoint 2010 中的空文本框

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub RemoveEmptyTextBoxes()
    Dim SlideObj As Slide
    Dim ShapeObj As Shape
    Dim ShapeIndex As Integer
    For Each SlideObj In ActivePresentation.Slides
        For ShapeIndex = SlideObj.Shapes.Count To 1 Step -1
            Set ShapeObj = SlideObj.Shapes(ShapeIndex)
            If ShapeObj.Type = msoTextBox Then
                If Trim(ShapeObj.TextFrame.TextRange.Text) = "" Then
                    ShapeObj.Delete
                End If
            End If
        Next ShapeIndex
    Next SlideObj
End Sub

[1] Office 2010 中的 VBA 入门
[2] Excel VBA Programming For Dummies