第8章 操作数字
加、减、乘、除、平方与指数（^2 或者^n）、平方根Sqr、正弦Sin、余弦Cos、正切Tan、反正切Atn、绝对值Abs
转换为整型数、长整型数、双精度型数和值
Cint当双精度型数向整型数转换时，CInt通过园整数字得到一个整型数
CLng与CInt相比：当所提供的值较大时使用CLng
Fix函数只是简单地甩掉数字的小数部分，它不做任何园整。Fix能够操作整型数和长整型数
CDbl函数可将提供的参数转换为一个双精度型数
Val函数能给出参数中的数字值。Val返回所有的数字字符直到它遇到一个非数字字符为止
IsNumeric返回一个布尔值（True 或 False) 它考察其参数并确定参数是否为数字
Round函数能够让我们指定小数点后保留的位数
Mod求余 5 Mod 2 = 1
Sgn求数的正负号。如果所给值是负数则返回-1，零返回0，正数返回1
Rnd与Randomize生成随机数
Double 的类型声明字符是数字符号 (#)。
Sub TestRnd() Dim I As Long Dim Lower As Long Dim Higher As Long Dim PointCen(0 To 1) As Point3d Dim PointElem As PointStringElement Dim Num As Double Lower = 0 Higher = 1 Num = 0 Randomize For I = 1 To 60000 PointCen(0).X = Round((Higher - Lower + 1) * Rnd(1), 2) PointCen(0).Y = Round((Higher - Lower + 1) * Rnd(1), 2) PointCen(1).X = PointCen(0).X PointCen(1).Y = PointCen(0).Y Set PointElem = Application.CreatePointStringElement1(Nothing, PointCen, True) ActiveModelReference.AddElement PointElem If Sqr((PointCen(0).X - 1) ^ 2 + (PointCen(0).Y - 1) ^ 2) < 1 Then Num = Num + 1 End If Next I Dim MyCir As EllipseElement Dim CenPt As Point3d Dim RotMatrix As Matrix3d CenPt.X = 1 CenPt.Y = 1 CenPt.Z = 0 Set MyCir = Application.CreateEllipseElement2(Nothing, CenPt, 1, 1, RotMatrix) Application.ActiveModelReference.AddElement MyCir Set MyCir = Application.CreateEllipseElement2(Nothing, CenPt, Sqr(2), Sqr(2), RotMatrix) Application.ActiveModelReference.AddElement MyCir MsgBox Num / 60000 MsgBox Atn(1)
Sub TestMessageBox2() Dim Mes As VbMsgBoxResult Mes = MsgBox("Unable to open file.", vbAbortRetryIgnore) Mes = MsgBox("Format Hard Drive?", vbOKCancel) Mes = MsgBox("New Level Added.", vbOKOnly) Mes = MsgBox("Not Connected to Internet.", vbRetryCancel) Mes = MsgBox("Do you want to continue?", vbYesNo) Mes = MsgBox("Continue Reading File?", vbYesNoCancel) Select Case Mes Case VbMsgBoxResult.vbAbort 'add codes Case VbMsgBoxResult.vbCancel 'add codes Case VbMsgBoxResult.vbIgnore 'add codes Case VbMsgBoxResult.vbNo 'add codes Case VbMsgBoxResult.vbOK 'add codes Case VbMsgBoxResult.vbRetry 'add codes Case VbMsgBoxResult.vbYes 'add codes End Select End Sub
Sub TestMessageBox3() Dim Mes As VbMsgBoxResult Mes = MsgBox("Unable to open file.", vbAbortRetryIgnore + vbCritical) Mes = MsgBox("Format Hard Drive?", vbOKCancel + vbExclamation) Mes = MsgBox("New Level Added.", vbOKOnly + vbInformation) Mes = MsgBox("Do you want to continue?", vbYesNo + vbQuestion) End Sub
Sub TestMessageBox4() MsgBox "Testing Title", vbCritical, "Title Goes Here" MsgBox "Testing Title", , "Title Goes Here" End Sub
标题参数显示在消息框的顶部，它是第三个参数，消息框仅有一个参数是必须的，那就是提示参数。要显示提示、标题以及缺省按钮，在提示参数后方一个逗号、一个空格、另一个逗号，然后是标题。若要跳过一个可选参数，就让这个参数空着并用逗号指明你要提供下一个参数了。
输入框
Sub TestInputBox2() Dim InpRet As String InpRet = InputBox("Enter Level Name:", "Level Creator", "Striping", 0, 0) Debug.Print "User entered" & InpRet End Sub
Now函数给出当前的系统日期和时间。
Sub TestNow() MsgBox Now End Sub
DateAdd函数能够展望未来或回忆过去
Sub TestDateAdd() Dim NowDate As Date NowDate = Now Debug.Print NowDate & vbTab & DateAdd("d", 4, NowDate) '日 Debug.Print NowDate & vbTab & DateAdd("h", 4, NowDate) '时 Debug.Print NowDate & vbTab & DateAdd("n", 4, NowDate) '分 Debug.Print NowDate & vbTab & DateAdd("s", 4, NowDate) '秒 Debug.Print NowDate & vbTab & DateAdd("m", 4, NowDate) '月 Debug.Print NowDate & vbTab & DateAdd("w", 4, NowDate) '周 Debug.Print NowDate & vbTab & DateAdd("yyyy", 4, NowDate) '年 Debug.Print NowDate & vbTab & DateAdd("q", 4, NowDate) '季 End Sub
DateDiff计算两个日期的时间差
Sub TestDateDiff() Dim NowDate As Date NowDate = Now Debug.Print "Days" & vbTab & DateDiff("d", NowDate, "1/1/3000") Debug.Print "Hours" & vbTab & DateDiff("h", NowDate, "1/1/3000") Debug.Print "Minutes" & vbTab & DateDiff("n", NowDate, "1/1/3000") Debug.Print "Seconds" & vbTab & DateDiff("s", NowDate, "1/1/3000") Debug.Print "Months" & vbTab & DateDiff("m", NowDate, "1/1/3000") Debug.Print "Weeks" & vbTab & DateDiff("w", NowDate, "1/1/3000") Debug.Print "Years" & vbTab & DateDiff("yyyy", NowDate, "1/1/3000") Debug.Print "Quarters" & vbTab & DateDiff("q", NowDate, "1/1/3000") End Sub
Timer 告诉我们自午夜开始所经历的秒数
Sub TestTimer() MsgBox Timer End Sub
FileDataTime可以给出文件最后修改的日期/时间
FileLen函数可以告知给定文件的大小 以字节为单位
Sub TestFileDateTime() Dim exeDate As Date exeDate = FileDateTime("C:Program Files (x86)BentleyMicroStation V8i (SELECTseries)MicroStationustation.exe") MsgBox "MicroStation Date/Time: " & exeDate End Sub Sub TestFileLen() Dim exeSize As Long exeSize = FileLen("C:Program Files (x86)BentleyMicroStation V8i (SELECTseries)MicroStationustation.exe") MsgBox "MicroStation Size: " & exeSize End Sub
MkDir建立新目录
RmDir函数从文件系统中删除一个目录。被删除的目录必须是空的，否则会产生一个错误。
Sub TestMkDir() MkDir "c:Program Files (x86)BentleyMicroStation V8i (SELECTseries)SourceCode" End Sub Sub TestRmDir() RmDir "c:Program Files (x86)BentleyMicroStation V8i (SELECTseries)SourceCode" End Sub
Dir函数能够查找文件和文件夹(目录)
Kill 该函数的结果是永久性的。被“杀掉”的文件没有送到回收站，它们被完全删除。使用时要特别小心！
Beep函数使电脑发出哔哔声，在代码运行过程中它能给用户一个快速的声音提示。
SaveSetting使用Windows注册表能保存用户在软件中的设置。微软已经为VBA程序建立了一个注册表路径，我们很容易地写、编辑和删除这个路径
GetSetting函数能够取得注册表中的设置
Sub TestSaveSetting() SaveSetting "Learning MicroStation VBA", "Chapter 9", "SaveSetting", "It Works" End Sub
Sub TestGetSetting() Dim RegSetting As String RegSetting = GetSetting("Learning MicroStation VBA", "Chpater 9", "SaveSetting") Debug.Print "The Key SaveSetting value is "" " & RegSetting & """" End Sub
DeleteSetting能够删除注册表中的设置
Sub TestDeleteSetting() DeleteSetting "Learning Microstation VBA", "Chapter 9", "SaveSetting" End Sub Sub TestDeleteSetting2() DeleteSetting "Learning Microstation VBA", "Chapter 9" End Sub Sub TestDeleteSetting3() DeleteSetting "Learning MicroStation VBA" End Sub
GetAllSettings函数从注册表中取得指定应用下的所有键，并把它们放入一个多维数组中
读写ASCII文件
Sub TestWriteASCIIA() Open "C:output.txt" For Output As #1 Print #1, "First line" Print #1, "Second line" Close #1 End Sub Sub TestWriteASCIIB() Open "C:output.txt" For Output As #1 Write #1, "First line" Write #1, "Second line" Close #1 End Sub Sub TestWriteASCIIC() Open "C:output.txt" For Append As #1 Print #1, "Another line 1." Print #1, "Another line 2." Close #1 End Sub Sub TestWriteASCIID() Dim FFileA As Long Dim FFileB As Long FFileA = FFile Open "C:outputa.txt" For Append As #FFileA Print #FFileA, "Another line 1." Print #FFileA, "Another line 2." FFileB = FreeFile Open "C:outputb.txt" For Append As FFileB Print #FFileA, "Another line 3." Print #FFileB, "Another line 3." Print #FFileA, "Another line 4." Print #FFileB, "Another line 4." Close #FFileB Close #FFileA End Sub Sub ReadASCIIA() Dim FFile As Long Dim TextLine As String FFile = FreeFile Open "C:output.txt" For Input As #FFile While EOF(FFile) = False Line Input #FFile, TextLine Debug.Print TextLine Wend Close #FFile End Sub
控制代码的执行
For…Next语句
P116
While …Wend
Do…Loop 可以使用Exit Do在任何时候退出Do…Loop语句
For Each…Next
If …Then还可以加上Else语句进行其他情况的处理，最后要加上End If
Select Case 相当于多个If语句
错误处理 On Error GoTo errhnd
On ErrorResume Next告诉VBA完全忽略错误并移动到下一行继续执行，从而代替去捕捉错误
errhand:
Select Case Err.number
Case 13 '类型不匹配
Err.Clear
'Resume Next
'Resume
End Select
本章回顾
VBA内置了很多过程和函数。使用内置的过程或者函数可以简化工作
第十章 可视界面
Sub PrintHeader(HeaderIn As String, FileNum As Long, Optional Columns As Long = 1) If optASCII.Value = True Then Print #FileNum, "[" & HeaderIn & "]" ElseIf optHTML.Value = True Then Print #FileNum, "<table width=660>" Print #FileNum, "<tr><td colspan=" & Columns & " align=center><b>" & HeaderIn & "</td></tr>" End If End Sub Sub PrintLine(LineIn As String, FileNum As Long) If optASCII.Value = True Then Print #FileNum, LineIn ElseIf optHTML.Value = True Then Dim XSplit As Variant Dim I As Long XSplit = Split(LintIn, vbTab) Print #FileNum, "<tr>" For I = LBound(XSplit) To UBound(XSplit) Print #FileNum, vbTab & "<td>" & XSplit(I) & "</td>" Next I Print #FileNum, "</tr>" End If End Sub Sub PrintFooter(FileNum As Long) If optHTML.Value = True Then Print #FileNum, "</table>" & vbCrLf End If End Sub Sub DoWriteFile() frmWriteDgnSettings.Show End Sub Private Sub cmdCancel_Click() Unload frmWriteDgnSettings End Sub Private Sub cmdOK_Click() Dim MyFile As String Dim FFile As Long Dim myLevel As Level Dim myLStyle As LineStyle Dim myTStyle As TextStyle Dim myView As View FFile = FreeFile If optASCII.Value = True Then MyFile = "c:output.txt" ElseIf optHTML.Value = True Then MyFile = "c:output.html" End If Open MyFile For Output As #FFile PrintHeader "FILE NAME", FFile, 1 PrintLine ActiveDesignFile.FullName, FFile PrintFooter FFile If chkLevels.Value = True Then PrintHeader "LEVELS", FFile, 3 For Each myLevel In ActiveDesignFile.Levels PrintLine myLevel.Name & vbTab & myLevel.Description & vbTab & myLevel.ElementColor, FFile Next PrintFooter FFile End If If chkLineStyles.Value = True Then PrintHeader "LINE STYLES", FFile, 2 For Each myLStyle In ActiveDesignFile.LineStyles PrintLine myLStyle.Name & vbTab & myLStyle.Number, FFile Next PrintFooter FFile End If If chkTextStyles.Value = True Then PrintHeader "TEXT STYLES", FFile, 3 For Each myTStyle In ActiveDesignFile.TextStyles PrintLine myTStyle.Name & vbTab & myTStyle.Color & vbTab & myTStyle.BackgroundFillColor, FFile Next PrintFooter FFile End If If chkViews.Value = True Then PrintHeader "VIEWS", FFile, 5 For Each myView In ActiveDesignFile.Views PrintLine myView.Origin.X & vbTab & myView.Origin.Y & vbTab & myView.Origin.Z & vbTab & myView.CameraAngle & vbTab & myView.CameraFocalLength, FFile Next PrintFooter FFile End If If chkAuthor.Value = True Then PrintHeader "Authr", FFile PrintLine ActiveDesignFile.Author, FFile PrintFooter FFile End If If chkSubject.Value = True Then PrintHeader "Subject", FFile PrintLine ActiveDesignFile.Subject, FFile PrintFooter FFile End If If chkTitle.Value = True Then PrintHeader "Title", FFile PrintLine ActiveDesignFile.Title, FFile PrintFooter FFile End If Close #FFile End Sub