Archive for '代码'

VBA产生正态分布随机数NormalRand

很多智能算法中经常需要产生正态分布的随机数来进行诸如领域搜索等功能,而在水文模拟中也可能需要产生一个正态分布的随机数列,这里在VBA中实现了一个正态分布随机数产生器,可以生成均值为0,方差为1.0的正态分布随机数生成,如果需要生成均值为Ex,方差为Cv的随机数可以使用 Ex + NormalRand()*Cv 来实现。具体VBA代码如下:
阅读全文 >

VBA中的高精度计时器

Excel中偶尔会用到高精度的计时器,如性能监视或统计,在一些水文应用(如水文数据查询或水文数据处理)中我们也可能非常需要了解整个程序的运行瓶颈在哪,以便有针对性地对程序进行改进,这就需要我们使用VBA调用API函数QueryFrequency与QueryCounter来实现,这里水文工具集对这些API调用进行了封装,包装为一个VBA的类,方便重复使用且易于调用。具体代码如下:
阅读全文 >

VBA以GIF文件格式导出Excel图表

Excel中使用VBA把图表保存为一个GIF文件是很容易的:只需要使用Chart对象的Export函数。下面是一个简单的宏,它把当前的图表保存为名为mychart.gif的GIF文件:

Sub ExportToGIF()
  If ActiveChart Is Nothing Then
    MsgBox "请先选择一个图表"
  Else
    ActiveChart.Export "mychart.gif"
  End If
End Sub


阅读全文 >

VBA中从网上下载文件

如果你开发的程序需要从网上下载一个文件,一般比较容易的方法是使用API函数URLDownloadToFile,本文介绍一个对此函数进一步包装,使得在VBA中更好的使用的VBA函数。这个函数名称为DownloadFile,原型如下:
阅读全文 >

Excel中根据单元格颜色进行排序

Excel中如果你想按照单元格颜色进行排序,Excel本身并不提供任何内建函数或者操作来完成,但可以使用自定义函数来完成。使用下面的函数可以获取单元格颜色:
阅读全文 >

VBA中播放声音

VBA中我们需要定时或者输入错误时播放声音来给用户进行提示,这是一个比较有用的功能,这里给出一段比较有效的代码,它调用了”winmm.dll”中的sndPlaySoundA函数:
阅读全文 >

VBA中创建全局惟一序号GUID

VBA中创建全局惟一序号:

Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Public Function CreateGUID() As String
    Dim G As GUID
    With G
    If (CoCreateGuid(G) = 0) Then
    CreateGUID = _
        String$(8 - Len(Hex$(.Data1)), "0") & Hex$(.Data1) & _
        String$(4 - Len(Hex$(.Data2)), "0") & Hex$(.Data2) & _
        String$(4 - Len(Hex$(.Data3)), "0") & Hex$(.Data3) & _
        IIf((.Data4(0) < &H10), "0", "") & Hex$(.Data4(0)) & _
        IIf((.Data4(1) < &H10), "0", "") & Hex$(.Data4(1)) & _
        IIf((.Data4(2) < &H10), "0", "") & Hex$(.Data4(2)) & _
        IIf((.Data4(3) < &H10), "0", "") & Hex$(.Data4(3)) & _
        IIf((.Data4(4) < &H10), "0", "") & Hex$(.Data4(4)) & _
        IIf((.Data4(5) < &H10), "0", "") & Hex$(.Data4(5)) & _
        IIf((.Data4(6) < &H10), "0", "") & Hex$(.Data4(6)) & _
        IIf((.Data4(7) < &H10), "0", "") & Hex$(.Data4(7))
    End If
    End With
End Function

使用时调用:

Dim UniqueID As String
UniqueID = CreateGUID()