MstnVBA学习--Vol4.其他VBA的基础知识--20220624

---

前言

这篇文章复习下标准VBA的调用

---

一. 对话框和目录操作

1. 消息框 MsgBox

用消息框来显示一些文字，这个框中带有一个 OK 按钮。

'在对话框中显示消息，等待用户单击按钮，并返回一个 Integer 告诉用户单击哪一个按钮。

'语法
'MsgBox(prompt[, buttons] [, title] [, helpfile, context])
'MsgBox 函数的语法具有以下几个命名参数：
'(1) Prompt 必需的。
'字符串表达式，作为显示在对话框中的消息。prompt 的最大长度大约为 1024 个字符，由所用字符的宽度决定。
'如果 prompt 的内容超过一行，'则可以在每一行之间用回车符 (Chr(13))、换行符 (Chr(10)) 或是回车与换行符的组合 (Chr(13) & Chr(10)) 将各行分隔开来。 
'(2) Buttons 可选的。
'数值表达式是值的总和，指定显示按钮的数目及形式，使用的图标样式，缺省按钮是什么以及消息框的强制回应等。
'如果省略，则 buttons 的缺省值为 0。 
'(3)Title 可选的。
'在对话框标题栏中显示的字符串表达式。如果省略 title，则将应用程序名放在标题栏中。 
'(4)Helpfile 可选的。
'字符串表达式，识别用来向对话框提供上下文相关帮助的帮助文件。如果提供了 helpfile，则也必须提供 context。 
'Context 可选的。数值表达式，由帮助文件的作者指定给适当的帮助主题的帮助上下文编号。如果提供了 context，则也必须提供 helpfile。 

'Buttons的参数有下列设置值
'		常数 					值 				描述 
'		第一组值					描述了对话框中显示的按钮的类型与数目
'		vbOKOnly				0				只显示 OK 按钮。 
'		VbOKCancel				1 				显示 OK 及 Cancel 按钮。 
'		VbAbortRetryIgnore 		2 				显示 Abort、Retry 及 Ignore 按钮。 
'		VbYesNoCancel 			3 				显示 Yes、No 及 Cancel 按钮。 
'		VbYesNo 				4 				显示 Yes 及 No 按钮。 
'		VbRetryCancel 			5 				显示 Retry 及 Cancel 按钮。 
'		第二组值					描述了图标的样式
'		VbCritical 				16 				显示 Critical Message 图标。 
'		VbQuestion 				32				显示 Warning Query 图标。 
'		VbExclamation 			48 				显示 Warning Message 图标。 
'		VbInformation 			64 				显示 Information Message 图标。
'		第三组值 				说明哪一个按钮是缺省值
'		vbDefaultButton1 		0 				第一个按钮是缺省值。 
'		vbDefaultButton2 		256 			第二个按钮是缺省值。 
'		vbDefaultButton3 		512 			第三个按钮是缺省值。 
'		vbDefaultButton4 		768 			第四个按钮是缺省值。 
'		第四组值					决定消息框的强制返回性
'		vbApplicationModal 		0 				应用程序强制返回；应用程序一直被挂起，直到用户对消息框作出响应才继续工作。 
'		vbSystemModal 			4096 			系统强制返回；全部应用程序都被挂起，直到用户对消息框作出响应才继续工作。 
'		vbMsgBoxHelpButton 		16384 			将Help按钮添加到消息框 
'		VbMsgBoxSetForeground 	65536 			指定消息框窗口作为前景窗口 
'		vbMsgBoxRight 			524288 			文本为右对齐 
'		vbMsgBoxRtlReading 		1048576 		指定文本应为在希伯来和阿拉伯语系统中的从右到左显示 

'将这些数字相加以生成 buttons 参数值的时候，只能由每组值取用一个数字。
'注意 这些常数都是 Visual Basic for Applications (VBA) 指定的。可以在程序代码中到处使用这些常数名称，而不必使用实际数值。

'返回值
'		常数			值 		描述 
'		vbOK 			1 		OK 
'		vbCancel 		2 		Cancel 
'		vbAbort 		3 		Abort 
'		vbRetry 		4 		Retry 
'		vbIgnore 		5 		Ignore 
'		vbYes 			6 		Yes 
'		vbNo 			7 		No 

'说明
'在提供了 helpfile 与 context 的时候，用户可以按 F1(Windows) or HELP (Macintosh) 来查看与 context 相应的帮助主题。
'像Microsoft Excel 这样一些主应用程序也会在对话框中自动添加一个 Help 按钮。
'如果对话框显示 Cancel 按钮，则按下 ESC 键与单击 Cancel 按钮的效果相同。
'如果对话框中有 Help 按钮，则对话框中提供有上下文相关的帮助。但是，直到其它按钮中有一个被单击之前，都不会返回任何值。

'注意 如果还要指定第一个命名参数以外的参数，则必须在表达式中使用 MsgBox。为了省略某些位置参数，必须加入相应的逗号分界符。

在指定按钮常数时加上图标常数，VBA会在消息框中同时显示按钮和图标。

---

2. 输入框 InputBox

输入框让用户输入文本。
如果用户点击取消(Cancel)或什么也没输入就点击确定(OK)，InputBox(即输入框)将返回一个空串。
VBA 中的空串表示中间什么内容也没有的两个双引号(“”)。

'语法

	InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
	
'(1)Prompt 必需的。
'作为对话框消息出现的字符串表达式。prompt 的最大长度大约是 1024 个字符，由所用字符的宽度决定。
'如果 prompt 包含多个行，则可在各行之间用回车符 (Chr(13))、换行符 (Chr(10)) 或回车换行符的组合 (Chr(13) & Chr(10)) 来分隔。 
'(2)Title 可选的。
'显示对话框标题栏中的字符串表达式。如果省略 title，则把应用程序名放入标题栏中。 
'(3)Default 可选的。
'显示文本框中的字符串表达式，在没有其它输入时作为缺省值。如果省略 default，则文本框为空。 
'(4)Xpos 可选的。
'数值表达式，成对出现，指定对话框的左边与屏幕左边的水平距离。如果省略 xpos，则对话框会在水平方向居中。 
'(5)Ypos 可选的。
'数值表达式，成对出现，指定对话框的上边与屏幕上边的距离。如果省略 ypos，则对话框被放置在屏幕垂直方向距下边大约三分之一的位置。 
'(6)Helpfile 可选的。
'字符串表达式，识别帮助文件，用该文件为对话框提供上下文相关的帮助。如果已提供 helpfile，则也必须提供 context。 
'(7)Context 可选的。
'数值表达式，由帮助文件的作者指定给某个帮助主题的帮助上下文编号。如果已提供 context，则也必须要提供 helpfile。 

---

3. 其他函数

(1) Now

• Now(现在)函数给出当前的系统日期和时间。这在生成一个日期/时间戳时很有用。Now 返回一个 Date(日期)类型的值。

(2) DateAdd

• Now 函数告诉我们当前日期/时间，DateAdd 函数能展望未来或回忆过去。

(3) DateDiff

• 如果有两个日期并且想知道它们之间的时间差，请用 DateDiff 函数。DateAdd 和 DateDiff 使用相同的间隔参数。

(4) Timer

• Timer 函数告诉我们自午夜开始所经历的秒数。这个函数在测试应用以查找代码中的瓶颈时很有用。

(5) FileDateTime

• FileDateTime 给出指定文件最后修改的日期/时间。

(6) MkDir

• 用 MkDir 建立新目录。要使 MkDir 正常工作，所有的父目录必须存在。

(7) RmDir

• RmDir 从文件系统中删除一个目录。被删的目录必须是空的，否则会产生一个错误。

(8) Dir

• Dir 函数能查找文件和文件夹(目录)。
  第一次使用该函数时，指定一个路径和文件名(允许通配符)，Dir 每次只返回一个文件/路径。
  如果要查找一组文件或文件夹，反复调用不带参数的 Dir。
  当 Dir 返回一个空串(“”)时，表明已返回所有。

(9) Kill

• Kill 函数的结果是永久性的。被“杀掉”的文件没有送到回收站，它们被完全删除。

(10) Beep

• Beep 函数使电脑发出哔哔声

(11) SaveSetting 对应 DeleteSetting

• 使用 Windows 注册表能 保存 / 删除 用户在软件中的设置。

(12) GetAllSettings

• GetAllSettings 从注册表中取得指定应用下的所有键，并把它们放入一个多维数组中。

---

二. 操作ASCII文件

1. 写ASCII文件: 先 Open, 后 Wirte 或 Print

• Write 和 Printe 的区别是: Write 函数在每行的开头和结尾处放置了双引号.

2. FreeFile

• 同时操作两个文件。当使用 FreeFile 时，把其返回值赋给变量.

• 请注意 FreeFile 用于多个变量的情况。如果用 FreeFile 连续给 FFileA 和FFileB 赋值，它们的值将会是相同的。FreeFile 仅当一个文件被打开后才会返回一个不同的值。

• 所以调用 FreeFile 后要打开以它为文件号的文件，然后再调用 FreeFile 以打开下一个文件。这样做就能避免取得相同的文件号，否则，当你本意是想读/写两个不同的文件时，可能偶尔会出现读/写同一文件的情况。

3. 读ASCII文件: 先Open, 后Line Input

• 源文件。用 Line Input 和文件号每次读文本文件中的一行，一直读下去直到遇到文件尾(EOF)。

---

三. 用循环来控制代码执行

1. For…Next

当知道要循环执行一段代码多少次时，用一个 For … Next 语句。

2. While…Wend

当不能确定要重复多少次代码块时使用 While … Wend。只要 While 语句为真，在While 和 Wend 之间的代码语句就继续执行。

3. Do…Loop

Do … Loop 语句与 While … Wend 非常相似，但它更通用些。
可以使用“Exit Do”在任何时候退出 Do … Loop 语句。实用的例子如下:

'本例让用户在MicroStation 中选择一个点，
'当用户选择了点以后就捕获这个点并退出Do 循环，然后在捕获的点处插入一个新单元。

Sub TestDoWhileA() 
	Dim CadMsg As CadInputMessage 
	Dim InsPt As Point3d 
	Dim CellElem As CellElement 
		Do While True 
			Set CadMsg = CadInputQueue.GetInput 
			Select Case CadMsg.InputType 
				   Case msdCadInputTypeDataPoint 
					InsPt = CadMsg.Point 
					Exit Do 
			End Select 
		Loop 
	Set CellElem = Application.CreateCellElement3("Column", InsPt, True) 
	ActiveModelReference.AddElement CellElem 
End Sub

根据自己的理解后, 稍加改进, 变成无限点击放置Cell的程序, 代码如下:

Sub TestDoWhileA()
    Dim CadMsg As CadInputMessage
    Dim InsPt As Point3d
    Dim CellElem As CellElement
        Do While True
            Set CadMsg = CadInputQueue.GetInput
            Select Case CadMsg.InputType
                   Case msdCadInputTypeDataPoint
                    InsPt = CadMsg.Point
                    Set CellElem = Application.CreateCellElement3("三头路灯", InsPt, True)
                    ActiveModelReference.AddElement CellElem
            End Select
        Loop
End Sub

4. For Each…Next

一些对象位于集合中，如每个 DGN 文档都有一个 Levels 集合，该集合由Level 对象组成。使用 For Each … Next 语句在集合中逐个查看对象。

Sub TestForNextA() 
	Dim dgnLevel As Level 
	For Each dgnLevel In ActiveDesignFile.Levels 
		Debug.Print dgnLevel.Name 
	Next 
End Sub 

5. If…Then

仅当指定的条件计算结果为真时才会执行 If … Then 语句中特定的代码块。

6. Select Case

Select Case 要求我们提供一个条件，然后是和该条件相匹配的多个可能值。

'本例查找输入的层名的首字符，基于首字符有多个可能的代码块要执行。
'如果首字符不是 A、B、C、D 或 E，就显示一个消息框且不添加新层。
'如果首字符满足一个准则，就在输入的层名前附加上固定的字符后添加该层。 
Sub TestSelectCaseA() 
	Dim LevelName As String 
	LevelName = InputBox("Enter Level Name:") 
	Select Case UCase(Left(LevelName, 1)) 
		Case "A" 
			ActiveDesignFile.AddNewLevel "A_" & LevelName 
		Case "B" 
			ActiveDesignFile.AddNewLevel "B_B_" & LevelName 
		Case "C", "D", "E" 
			ActiveDesignFile.AddNewLevel "CDE_" & LevelName 
		Case Else 
			MsgBox "Not a valid level name." 
	End Select 
End Sub

---

四. 错误处理

VBA 为我们提供了一些处理错误的工具。

• 用一个形象的例子来说明下如何灵活运用错误处理的代码

'TestErrorHndA 向用户提问一条线的长度。
'在要求用户输入一个长度时，如果不处理类型不匹配错误，用户将看到一个未经处理的错误消息框。
'如果像上面的宏那样对错误加以处理，用户会看到这样 "Line Lengths must be numeric." 

Sub TestErrorHndA() 
	On Error GoTo errhnd 
	Dim LineLength As Double 
		LineLength = CDbl(InputBox("Enter Line Length:")) 
	Exit Sub 
	errhnd: 
		Select Case Err.Number 
		Case 13 '类型不匹配 
			MsgBox "Line Lengths must be numeric." 
			Err.Clear 
	End Select 
End Sub 

'在处理错误时，既可以显示消息框告知用户发生了错误。
'可以后台处理特定的错误，这样用户就不会知道发生了什么。

• 错误处理是重点, 所以一点一点的剖开来看:

On Error GoTo errhnd这句是告诉VBA, 如果遇到一个错误, 就跳转到标记为errhnd的代码区

每个错误都有一个编号与之关联, 用Select Case处理不同类型的错误, 但如果发生Case之外的错误情况呢?
VBA的消息框给予我们一些很有用的信息。它告诉我们错误号, 知道错误号把这个编号加入到代码的错误处理部分。具体例子可以参见下面改编的代码:

'TestSelectCase过程还是和前面一样, 但是如果两次输入了同样名称的层, 那就需要第二部分的Errhnd了

Sub TestSelectCaseA()
    On Error GoTo Errhnd			'!!!处理错误
    Dim LevelName As String
    LevelName = InputBox("Enter Level Name:")
    Select Case UCase(Left(LevelName, 1))
        Case "A"
            ActiveDesignFile.AddNewLevel "A_" & LevelName
        Case "B"
            ActiveDesignFile.AddNewLevel "B_B_" & LevelName
        Case "C", "D", "E"
            ActiveDesignFile.AddNewLevel "CDE_" & LevelName
        Case Else
            MsgBox "Not a valid level name."
    End Select

'Errhnd下面有Select Case结构, 用来处理不同类型的错误
Errhnd:	
	Select Case Err.Number
		Case 13 '类型不匹配
		MsgBox "Line Lengths must be numeric."
		Case -2147221504 '已有重复的层, 请使用其他名称的层'
		'出错后弹出带黄色叹号图标的MsgBox对话框
		MsgBox "已有重复的层, 请使用其他名称的层", VBExclamation		
		Err.Clear
		Resume Next			'加入这句能忽略出错代码行移到下一行执行, 
							'Resume 则是让VBA重试出错的代码行
	End Select
End Sub


' "On Error Resume Next" 能告诉VBA完全忽略错误并移动到下一行继续执行,从而代替去捕获错误. 
' 虽然这个句子显得有些随意, 但是有时候很有帮助!
Sub TestErrorHndD() 
	On Error Resume Next 
	Dim LineLength As Double 
		LineLength = CDbl(InputBox("Enter Line Length:")) 
End Sub 

下面是个和Excel相关的比较典型且考虑全面的错误处理的例子, 用CreateObjective启动Excel应用, 有几种可能的错误:

• (1) 设置 Excel 应用的 Visible(可见)属性为真就会引发一个错误
• (2) Excel 不能启动的原因很可能是根本就没有安装
• (3) 即使 Excel 运行了还有可能没有打开一个 Excel 工作簿(.xls)文件

Sub TestErrHndE() 
	On Error Resume Next 
	Dim MyExcel As Object 
	Set MyExcel = GetObject(, "Excel.Application") 
	If Err.Number <> 0 Then 
		Err.Clear 
		Set MyExcel = CreateObject("Excel.Application") 
	End If 
	On Error GoTo errhnd 
		MyExcel.Visible = True 
		MsgBox MyExcel.ActiveSheet.Name 
		Exit Sub 
	errhnd: 
		MsgBox "Error " & Err.Number & " has occurred." & vbCr & Err.Description, vbCritical, "Error In TestErrHndE" 
		Err.Clear 
End Sub 

Sub TestErrorHndF() 
	On Error GoTo errhnd 
	Dim LineLength As Double 
	On Error GoTo 0 
	LineLength = CDbl(InputBox("Enter Line Length:")) 
	Exit Sub 
errhnd: 
	MsgBox "Error " & Err.Number & " has occurred." & vbCr & _ 
	Err.Description, vbCritical, "Error In TestErrHndE" 
	Err.Clear 
End Sub 

“On Error GoTo 0”(Goto 之后是一个零)告诉 VBA 忽略前面的“On Error” 语句并继续运行就好像没有错误处理一样。

这样做也有用处，你将看到一个显示错误号和描述外加调试(Debug)按钮的错误对话框。
点击 Debug 转到有问题的代码行。

一旦找到并修正错误就可以注释掉“On Error GoTo 0”这一行而使你的错误处理代码再次起作用。

总结

前三部分相对好理解, 但最后错误处理这部分内容还需要多多练习, 目前初期感觉是懵懵懂懂的