VBA 操作数字

第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)\Bentley\MicroStation V8i (SELECTseries)\MicroStation\ustation.exe")

MsgBox "MicroStation Date/Time: " & exeDate

End Sub

Sub TestFileLen()

Dim exeSize As Long

exeSize = FileLen("C:\Program Files (x86)\Bentley\MicroStation V8i (SELECTseries)\MicroStation\ustation.exe")

MsgBox "MicroStation Size: " & exeSize

End Sub

MkDir建立新目录

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

Sub TestMkDir()

MkDir "c:\Program Files (x86)\Bentley\MicroStation V8i (SELECTseries)\SourceCode"

End Sub

Sub TestRmDir()

RmDir "c:\Program Files (x86)\Bentley\MicroStation 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
时间: 2024-11-05 15:00:18

VBA 操作数字的相关文章

Numeral.js – 格式化和操作数字的 JavaScript 库

Numeral.js 是一个用于格式化和操作数字的 JavaScript 库.数字可以格式化为货币,百分比,时间,甚至是小数,千位,和缩写格式,功能十分强大.支持包括中文在内的17种语言. 您可能感兴趣的相关文章 太赞了!超炫的页面切换动画效果[附源码下载] 创意无限!一组网页边栏过渡动画[附源码下载] 真是好东西!13种非常动感的页面加载动画效果 你见过吗?9款超炫的复选框(Checkbox)效果 时尚设计!三种奇特网格加载效果[附源码下载] 源码下载      在线演示 本文链接:Numer

NET中如何操作数字证书详解

.NET为我们提供了操作数字证书的两个主要的类,分为为: System.Security.Cryptography.X509Certificates.X509Certificate2类, 每个这个类的实例可以表示一个证书: System.Security.Cryptography.X509Certificates.X509Store类,可以对保存在计算机安全区域内的证书进行add/remove/get操作. 另外我们可以使用System.Security.Cryptography.X509Cer

js 操作数字类型

1.内置函数 Number().parseInt().parseFloat() var num = "88.88abc888"; Number(num);                    //NaN parseFloat(num);                //88.88 parseFloat(Number(num));   //NaN 2.Number.toFixed(x) . Number.toPrecision(x) . Math.Round(x)的区别: 都有四舍五

C# vba 操作 Word

添加引用 Microsoft Word  *.0 Object Library Microsoft Graph *.0 Object Library 变量说明 Object oMissing = System.Reflection.Missing.Value; object oEndOfDoc = "\\endofdoc"; 操作类说明 Microsoft.Office.Interop.Word.Application WordApp = new Microsoft.Office.In

关于Visio的vba操作,遍历目录,对所有vsd文件操作,导入excel文件

1.vba遍历要添加引用,runtime 2.不能打开单独的application,因为在获取到shape的picture属性时候,新打开的application不能够获取到.提示自动化错误. 3.定位shape的话,需要shape的宽高,因为是基于中心点的定位.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU 设置属性的格式如此,没有好办法了. 4.shape的name,text可以赋值,通过name的唯一性来判

VBA 操作 Excel 生成日期及星期

直接上代码~~ 1.  在一个 Excel 生成当月或当年指定月份的日期及星期 ' 获取星期的显示 Function disp(i As Integer) Select Case i Case 1 disp = "一" Case 2 disp = "二" Case 3 disp = "三" Case 4 disp = "四" Case 5 disp = "五" Case 6 disp = "六&q

VBA 操作 VBE

Introduction You can write code in VBA that reads or modifies other VBA projects, modules, or procedures. This is called extensibility because extends the editor -- you can used VBA code to create new VBA code. You can use these features to write cus

VBA操作Excel

几个小知识: 1.设置单元格格式: sht.Cells(4, pCol).NumberFormatLocal = "yyyy-mm-dd hh:mm:ss" 其中文本格式为:"@",常规格式为:G/通用格式 2.设置单元格为自动列宽或自动高度: #1.VBA自动生成的代码为:Columns("A:D").EntireColumn.AutoFit #2.但是字母的A到D,我们在VBA中不方便取到,一般都是数据,所以使用 Range(Cells(1,

MicroStation VBA 操作提示

Sub TestShowCommand() ShowCommand "画条线" ShowPrompt "选择第一个点" ShowStatus "选择第二个点" End Sub Sub TestShowTempMessage() ShowTempMessage msdStatusBarAreaLeft, "消息左侧" ShowTempMessage msdStatusBarAreaMiddle, "消息中部"