三．图表格式设置 对于图的格式设置，一般是录制一个宏，再删除不需要的语句，这样是开发者最省事的方法。在本节 的示例中有详细的格式设置，可以更改坐标轴的名?，大小范围，刻度大小等。对不清楚的图的类型名?， 格式参数，我们都可以通过录制宏来了解学习。时刻记住，录制宏来分析代码，是最好的学习方法。 四．散点图增加一个系列和增加文字标签 1）用图表的系列集合对象的方法 NewSeries，就可以增加图的系列，然后再对新系列进行设置，如下： mychart.chart.SeriesCollection.NewSeries ‘ 增加一个系列数据 mychart.chart.SeriesCollection(1).XValues = Array(45, 100) ‘横坐标数据组或单元对象 mychart.chart.SeriesCollection(1).Values = Array(50, 180) ‘ 纵坐标数据组或单元对象 2）对于散点图，我们可以增加文字标签于图上，方法如下：增加一个新的系列，不过数据就一点，不显 示数据点，而仅显示它的数据标签即可。如下示例。 With mychart.chart.SeriesCollection(2) .MarkerStyle = xlNone ‘ 不显示点标记 .Points(1).HasDataLabel = True ‘ 数据标记及显示文字标签 .Points(1).DataLabel.Text =”标签文字” ‘ 标签文字 .DataLabels.Position = xlLabelPositionCenter ‘ 位置风格，居中 End With 五．实例 1） 生成一个散点嵌入图于工作表窗口中心，绘制一条直线（45,50）— (100,180), 在第一点显示文字标签 “Test”，此外还加一个点（ 80， 100）。 代码和详细注释如下： Sub DrawChart() ‘*******************************图表对象的定义和生成*********************************** ‘定义对象变量，以便设置它为图表（ chart）对象及图位置大小变量 Dim mychart As Object, mysheet As Object Dim ChrLeft As Long, ChrTop As Long, ChrWidth As Long, ChrHeight As Long On Error Resume Next Application.ScreenUpdating = False
ChrWidth = 250: ChrHeight = 250 ChrLeft = Abs(Windows(ThisWorkbook.Name).Width – ChrWidth) / 2 ChrTop = Abs(Windows(ThisWorkbook.Name).Height – ChrHeight) / 2 ‘ 计算图表在窗口中心坐标 Set mychart = Sheets(1).ChartObjects. Add(ChrLeft, ChrTop, ChrWidth, ChrHeight) With mychart.Chart .ChartType = xlXYScatterLines ‘ 散点折线图类型 .SeriesCollection.NewSeries ‘ 增加一次投点,画条直线 .SeriesCollection(1).XValues = Array(45, 100) .SeriesCollection(1).Values = Array(50, 180) .SeriesCollection(1).Points(1).HasDataLabel = True ‘ 点1是否显示数据标签 .SeriesCollection(1).Points(1).DataLabel.Text = "Test" ‘ 点1的标签文字 .SeriesCollection.NewSeries ‘ 增加一次投点,就投个点（ 80，100） .SeriesCollection(2).XValues = 80 .SeriesCollection(2).Values = 100 End With ‘*******************************图表风格定义*********************************** With mychart.Chart .ChartArea.Font.Size = 10 ‘ 图表字符的大小 .HasLegend = False ‘ 图是否显示图例 .Axes(xlCategory, xlPrimary).HasTitle = True ‘X 轴是否有坐标名 .Axes(xlCategory, xlPr imary).AxisTitle.Characters.Text = "X" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrim ary).AxisTitle.Characters.Text = "Y" ‘Y轴坐标名"Y" .PlotArea.Interior.ColorIndex = xlNone ‘ 定义投图区为透明 End With With mychart.Chart.Axes(xlCategory) .MinimumScale = 0 ‘ 定义X坐标轴最小值 .MaximumScale = 200 ‘ 定义X坐标轴最大值 .MinorUnit = 10 ‘ 定义次刻度线单位 .MajorUnit = 50 ‘ 定义主刻度线单位 .CrossesAt = 0 ‘X 轴交汇点设为0 .MajorTickMark = xlInside ‘ 主刻度线方向朝内 .MinorTickMark = xlInside ‘ 次刻度线方向朝内 .HasMajorGridlines = False ‘ 是否显示主网格线 .HasMinorGridlines = False ‘ 是否显示次网格线 End With With mychart.Chart.Axes(xlValue) .MinimumScale = 0 ‘ 定义y坐标轴最小值 .MaximumScale = 200 ‘ 定义y坐标轴最大值 .MinorUnit = 10 ‘ 定义次刻度线单位 .MajorUnit = 50 ‘ 定义主刻度线单位 .CrossesAt = 0 ‘Y 轴交汇点设为0
.MajorTickMark = xlInside ‘ 主刻度线方向朝内 .MinorTickMark = xlInside ‘ 次刻度线方向朝内 .HasMajorGridlines = False ‘ 是否显示主网格线 .HasMinorGridlines = False ‘ 是否显示次网格线 End With Set mychart = Nothing ‘ 删除图表对象变量 Application.ScreenUpdating = True ‘ 恢复屏幕刷新 End Sub 2）根据工作表一的 A1：B10数据生成柱状图嵌入表一，位置为数据右下角位置。 Sub Pic2() On Error Resume Next Application.ScreenUpdating = False Charts.Add ActiveChart.ChartType = xlColumnClustered ActiveChart.SetSourceDat a Source:=Sheets("Sheet1").Range("A1:B10"), PlotBy:=xlColumns ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1" ActiveSheet.Shapes(ActiveSheet.Shapes.C ount).Left = ActiveSheet.Cells(11, 3).Left ‘定位于单元格 (10,2)右下角 ActiveSheet.Shapes(ActiveSheet.Shape s.Count).Top = ActiveSheet.Cells(11, 3).Top Application.ScreenUpdating = True End Sub 第三章 Excel VBA高级使用 通过以上章节的学习，估计大家都够能使用 Excel VBA进行基本的数据计算、数据汇总、数据的保存、 数据库的使用和绘制图表了，这些功能已经可以解决我们平时所遇到的大多数问题。但有时还会遇到一些 较难的问题，如计算机硬件或底层方面的使用。这些问题可以使用本章介绍的Windows API来解决。 Windows API是Windows的 32位应用程序编程接口，是一系列复杂函数、消息和结构的集合。这种 集合被包含在一个后缀名为 DLL的动态连接库文件中，装有Windows系统的电脑都有标准的Windows动 态连接库文件。编程人员可用不同编程语言的引用方法来使用它们，进而编制出解决 Windows系统底层问 题的应用程序。Excel VBA中使用 API可以让我们轻松实现一些高级功能，比如多媒体播放等，所以有必 要了解一些 API在 Excel VBA中的使用。一般来讲，只有会了Windows API才算真正进入了Windows系 统下程序开发的大门。 第一节 Win API的使用 Windows API 是英文Application Programming Interface的缩写，Win32 API也就是微软Windows 32位 操作系统的应用程序编程接口。我们可以认为 API函数是构筑整个Windows框架的基石，在它的下面是 Windows的操作系统核心，而它上面则是Windows的应用程序。在 Excel VBA中使用 API就是为了开发 出实用高效的应用程序，而 VBA下使用 API函数需进行API函数的堀明才能使用。 一、堀明 API函数 堀明 VBA所在文件之外的过程或函数就能够访问 Windows API或其它外部动态连接库（ DLL）。在堀 明了过程或函数后，其调用方法与 VBA自己的过程或函数调用方法相同。要堀明一个 DLL文件中的过程
或函数，需要在代码窗口增加一个 Declare语句。例如取的计算机名?的函数 GetComputerName ，作如 下堀明： Private Declare Function GetComputerName Lib "kernel 32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long 或 Public Declare Function GetComputerName Lib "kernel 32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long 以上堀明的不同在于所堀明函数的使用范围， Private Declare堀明的是模块私有，只能在堀明它的模 块内调用； Public Declare堀明的是全局函数，可以在应用程序的任何地方调用，一般我们使用 Public Declare 堀明。堀明完毕后就能在程序中使用此函数。 二、使用 API函数或过程 以 API函数 Beep来说明 API函数的几种使用方法， Beep函数的介绍如下： 【 VBA堀明】 Public Declare Function Beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long 【说明】 用于生成简单的堀音 【返回值】 Long，非零表示成功，否则返回零。 【参数表】 dwFreq ——— Long，堀音频率（从 37Hz到32767Hz）。 dwDuration —– Long，堀音的持续时间，以毫秒为单位。如为 -1，表示一直播放堀音，直到再次调用 该函数为止。 可采用以下几种方式使用API函数或过程，以 Beep为例： （1）忽略函数返回值的调用： Beep 1000, 5000 注意此时函数的参数是不加括号的。 （2） Call方法调用： Call Beep(1000, 5000) 注意这里需要加上括号，但我们不取回函数的返回值。 （3）取得函数返回值的调用： MyLng = Beep(1000, 5000) 此时需要加上括号，而且我们必须事先定义一个变量（变量的类型与函数返回值类型相同）来存储 API函数的返回值。 三、堀明的一些说明 （1）堀明中的 Lib 和 Alias 是怎么回事 一般情况下Win32 API函数总是包含在Windows系统自带的或是其它公司提供的动态连接库 DLL中， 而 Declare语句中的关键字Lib就是用来指定 DLL（动态连接库）文件路径是系统库路径的，这样 VBA才 能找到这个 DLL文件，然后才能使用其中的 API函数。 如果我们只是列出 DLL文件名而不指出其完整路径的话， VBA会自动到 Excel文件所在目录、当前工 作目录、Windows\System目录、Windows目录下搜寻这个 DLL文件。所以如果所要使用的 DLL文件不在
上?几个目录下的话，我们应该指明其完整路径。 Alias用于指定 API函数的别名，如果我们调用的 API函数要使用字符串（参数中包含 String型）的话， Alias关键字是必须的。这是因为在 ANSI和 Unicode字符集中同一API函数的名?可能不一样，为了保证 不出现堀明错误，所以我们使用 Alias关键字指出API函数的别名。 （2）常见API参数类型的说明 API函数的参数中最常见的是长整型数据（ Long）类型，例如 API中的句柄、一些特定的常量、函数 的返回值都是此类型的值；另外几种常见的参数类型有：整型Integer、 Byte型、String型等。 （3）堀明中的 ByVal是作什么用的 这跟 VBA的参数传递方式有关，在默认情况下 VBA是通过传值方式传递函数的参数、而有些 API函 数要求必须采用地址传递方式（ByRef）来传递函数参数（这两种参数传递方式是不同的，前者传递的是 参数真实的值，而后者要求是一个地址指针）。堀明中的 ByVal 表明参数是传递一个值。 （4）怎样轻松得到完整API函数堀明 Visual Basic 6.0 自带 API文本查看器 API Text Viewer，我们可以使用它来找到 API函数的完整堀明， 然后把它粘贴到程序就可使用。如果未安装VB6，大家可以到网上下载，此外网络上还有很多 API函数的 介绍，大家也可以下载来学习。 大家使用 API有必要对它进行有一定了解，然后再去使用 API文本查看器。虽然不必刻意研究每个 API 函数（如果真的知道 100来个 API函数的使用，相信绝对有用），但是需要我们了解一下该函数的作用。 而对 API函数功能的介绍，网络也有现成的软件供大家下载使用。 四、示例 （1）弹出一个对话框，提示计算机的名?，并且扬堀器喇叭会鸣叫。 Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long Private Const MAX_COMPUTERNAME_LENGTH As Long = 31 Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Sub ComputerName() Dim dwLen As Long Dim strString As String ‘创建缓冲区 32位 dwLen = MAX_COMPUTERNAME_LENGTH + 1 strString = String(dwLen, "X") ‘获得计算机名? GetComputerName strString, dwLen ‘获得实际名?字串 strString = Left(strString, dwLen) ‘播放频率为 4500赫兹的扬堀器堀音，持续 100微秒 For I = 0 To 5 Beep 4500, 100 DoEvents Next ‘显示计算机名?
MsgBox "电脑名?是 " & strString & ", 我搞对了吗？ " End Sub （2） API函数 ShellExecute的使用，打开网页和发送邮件。 API函数 ShellExecute的介绍： 【 VBA堀明】 Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 【别名】 ShellExecuteA 【说明】 查找与指定文件关联在一起的程序的文件名 【返回值】 Long，非零表示成功，零表示失败。 【参数表】 hwnd ———– Long，指定一个窗口的句柄，有时候，windows程序有必要在创建自己的主窗口前 显示一个消息框 lpOperation —- String，指定字串“ open”来打开 lpFlie文档，或指定“ Print”来打印它 lpFile ——— String，想用关联程序打印或打开一个程序名或文件名 lpParameters — String，如 lpszFlie是可执行文件，则这个字串包含传递给执行程序的参数 lpDirectory —- String，想使用的完整路径 nShowCmd ——- Long，定义了如何显示启动程序的常数值。参考ShowWindow函数的 nCmdShow 参数 示例代码： Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Const SW_SHOWNORMAL As Long = 1 Private Sub CommandButton1_Click() Unload Me End Sub Private Sub Label4_Click() ‘启动邮件程序 ShellExecute 0, "Open", "mailto:zhoujibin123@1126.com", "", "", SW_SHOWNORMAL Unload Me End Sub Private Sub Label5_Click() ‘启动网络程序, 连接到Excelhome论坛的帖子上 ShellExecute 0, "Open", _ "http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=462739&id=178278&page=1&skin=0&Star=1", "", "", SW_SHOWNORMAL
Unload Me End Sub 第二节 Excel VBA程序的保密 Excel VBA 程序的保密是个难点，大家对此都感兴趣，原因是想保护核心代码和技术以及对商业的 Excel VBA 程序进行安全保障。Excel 对 VBA 工程加密仅起简单保护作用，稍懂一点的程序员就可手工 破解或使用网上的破解软件。目前唯一能保障 VBA 代码就一个方法，把 VBA 核心代码封装到动态连接 库（ DLL）文件中。大家可以放心动态连接库，因为它是很难被反编译的（反编译的代价比开发还大） 、 非常安全。下面就开始介绍如何制作和使用动态连接库 DLL。 一、动态连接库 DLL的制作和使用 1）用 VB6 企业版下 ActiveX.DLL 工具开发，在缺省类代码窗口输入下面代码： Sub copy12(x As Integer, y As Integer) ‘ 目的是把表x单元格值赋值给表 y ‘定义将要用到的变量数据，对象变量，整型数据变量 Dim xlapp As Object, xlbok As Object,xlsht1 As Object,xlsht2 As Object, xlrng As Object Dim i As Integer, j As Integer, irow1 As Integer, icol1 As Integer Dim irow2 As Integer, icol2 As Integer, cellssum As Integer Set xlapp = GetObject(, "Excel.Application") ‘取得 Excel实例 Set xlbok = xlapp.activeworkbook ‘ 取得 Excel实例下活动工作簿 Set xlsht1 = xlbok.Worksheets(x) ‘ 取得 Excel实例下活动工作簿的第 x表格 Set xlsht2 = xlbok.Worksheets(y) ‘ 取得 Excel实例下活动工作簿的第 y表格 Set xlrng = xlsht1.UsedRange ‘ 取得 Excel实例下活动工作簿的第x表格的已用区域 cellssum = xlrng.Count ‘x 表格的已用区域的单元格数目 irow1 = xlrng.cells(1).row ‘ 已用区域的第1单元格的行 icol1 = xlrng.cells(1).Column ‘ 已用区域的第1单元格的列 irow2 = xlrng.cells(cellssum).row ‘ 已用区域的最后单元格的行 icol2 = xlrng.cells(cellssum).Column ‘ 已用区域的最后单元格的列 For i = irow1 To irow2 ‘ 从已用区域第1行到最后一行循环 For j = icol1 To icol2 ‘ 从已用区域第1列到最后一列循环 xlsht2.cells(i, j) = xlsht1.cells(i, j) ‘ 把x表已用区域单元格数据赋值给y表相同位置 Next ‘ 此处目的可用别方法实现，或加判断实现别的 Next Set xlapp = Nothing ‘ 清除定义的对象为空 Set xlbok = Nothing Set xlsht1 = Nothing Set xlsht2 = Nothing Set xlrng = Nothing End Sub Function Getstrgs(STRG As String, FC As String, LC As String) As Variant ‘求字符间各子串赋值给数组 Dim ss() As String On Error Resume Next
Sum = 0 For i = 1 To Len(STRG) – 1 If Mid(STRG, i, 1) = FC Then For j = i + 1 To Len(STRG) If Mid(STRG, j, 1) = LC Then Sum = Sum + 1 Next End If Next If Sum < 1 Then MsgBox "No substring found!" Exit Function End If ReDim ss(Sum – 1) As String Sum = 0 For i = 1 To Len(STRG) – 1 If Mid(STRG, i, 1) = FC Then For j = i + 1 To Len(STRG) If Mid(STRG, j, 1) = LC Then ss(Sum) = Mid(STRG, i + 1, j – i – 1) Sum = Sum + 1 End If Next End If Next Getstrgs = ss End Function 以上代码仅展示类中的过程和函数，以便在 VBA中使用。 2）修改将要引用的类名?，在 VB6的类属性窗口修改，本例修改为 mycopy1to2 3）工程保存，本例保存为 sheetcopy1to2 4） DLL生成，本例保存为sheetcopy1to2.dll 2-4步骤对大家来说，不应该存在问题的。 二． VBA中调用 DLL 1） VBE窗口下，点工具菜单-引用，在点弹出窗口的浏览按钮，找到你的 DLL文件，最好和 EXCEL 文件放一个目录下，便于下一步骤。 2） DLL的注册，如下： Private Sub Workbook_BeforeClose(Cancel As Boolean) Shell "Regsvr32 /u /s " & Chr(34) & ThisWorkbook.Path & "\sheetcopy1to2.dll" & Chr(34) End Sub Private Sub Workbook_Open() ‘一定要先引用 dll，才可以自动注册."Regsvr32 /s " 中/s是表示不出现对话框
On Error GoTo errline Shell "Regsvr32 /s " & Chr(34) & ThisWo rkbook.Path & "\sheetcopy1to2.dll" & Chr(34) Exit Sub errline: MsgBox "程序在注册DLL函数时出现错误！ " End Sub 也可以在Windows 开始菜单下的运行命令对话框中运行 Regsvr32 "DLL全路径/文件名 .dll" 来注册 DLL文件 3） VBA中使用 DLL的过程和函数，代码示例如下 VBE下新建如下模块： Sub mycopy1to2() Dim bb As New mycopy1to2 ‘ 定义 bb为 DLL中的类mycopy1to2 bb.copy12 1, 2 ‘ 表格1内容到表格2，使用类mycopy1to2新实例 bb的过程 Set bb = Nothing End Sub Sub mycopy2to3() Dim bb As New mycopy1to2 bb.copy12 2, 3 ‘ 表格2内容到表格 3 Set bb = Nothing End Sub Sub mycopy3to1() Dim bb As New mycopy1to2 bb.copy12 3, 1 Set bb = Nothing End Sub Sub string1() Dim aa As Variant Dim bb As New mycopy1to2 ‘ 定义 bb为 DLL中类 mycopy1to2 新实例 aa = bb.Getstrgs(Cells(1, 1), Cells(1, 2), Cells(1, 3)) ‘使用类mycopy1to2新实例 bb的函数 For i = 0 To UBound(aa) ‘用 DLL中类的函数求字符串的各子串 Cells(i + 2, 1) = aa(i) Next Set bb = Nothing End Sub 代码能理解多少就多少，这是次要的，主要是学会如何轻松使用 DLL保护自己的 VBA代码。学到这， 相信大家应该已经会制作 DLL文件和在 VBA中使用它了。 2) 获得硬盘物理地址
为什么要获得物理地址，那是因为电脑上唯一不变的就是硬盘物理地址号码。比如网卡的物理地址， 大家都会改动。因此获得该硬盘物理地址号码用来加密和注册，便显得非常之重要。其获得地址的代码如 示例，由于其较长，所以这里就省略。实际使用时，把该代码和注册加密的代码封装到 DLL库中使用。 3) 加密与注册 对正版软件的注册，有效的方法是一机一码，即一匀电脑一个注册码。即使别人获得了注册码和软 件，在别的机子上也无法使用。这一机一码就是基于电脑硬盘的唯一物理地址。打个比方来理解这个方法： 电脑上的硬盘物理地址为 DISK_ID，经过钥匙串 KEY1加密得到User_ID；软件开发人员然后根据钥匙串 KEY1解密User_ID获得用户的 DISK_ID，再经钥匙串 KEY2加密获得所谓的注册号Reg_ID；用户输入 Reg_ID并存在电脑注册表或文件上，软件启动后，调用注册核对功能，通过 KEY2加密 DISK_ID获得一 字符串，与 REG_ID对比，看是否一致，不一致则提示未注册并关闭程序运行。这里的KEY1和 KEY2及 加密解密算法，都存放在 DLL中，核心程序也存放在该DLL中，所以该方法注册可以保证一机一码且安 全。下面就介绍多种字符串加密解密算法的一种，是我以前看啥资料想到后设计出的。 基础原理如下： A. 可见字符的ASC码：0-9的 Asc码为 48-57；大写A-Z的 Asc码为 65-90；小写a-z 的 Asc码为 97-122。 Asc码是一整数型数据，占一个字节8位长度。 B. 异或操作（对应位的数字不同则为 1，相同为0）：举个例，电脑里一个字节的二进制数： 01101110 与11000011异或结果为10101101，该结果在与11000011再异或一次，其结果是 01101110，这与开始的数 相同，所以一个数对另一个数两次异或就会复原。 （1）加密步骤，PlainStr为待加密字串， KEY为钥匙字串。 第一步：取 KEY第一个字符的 Asc码和 PlainStr每一个字符的 Asc码异或，如果异或结果为可见字符的 Asc码范围，则其 Asc码对应的字符为新加密字符，否则新加密字符就是刚才的 PlainStr对应位置的字符， 各个加密字符合并就是被 KEY第一个字符的 Asc码加密过的字符串，并取代 PlainStr。 第二步：循环第一步，依次用 KEY的其余字符按第一步方法执行，得到最后的PlainStr。 第三步：异或操作后的 PlainStr长度为偶数，则分为左右两半，左右两字符串各自进行反序，其后合并 成一个字符串。 第四步：经过以上三步的操作， PlainStr字符串就经过钥匙字串 KEY的加密。 （2）解密步骤，PlainStr为待解密字串， KEY为钥匙字串。 第一步：PlainStr长度为偶数，则分为左右两半，左右两字符串各自进行反序，其后合并成一个新的字 符串 PlainStr。 第二步：取 KEY最后一个字符的 Asc码和 PlainStr每一个字符的 Asc码异或，如果异或结果为可见字符 的 Asc码范围，则其 Asc码对应的字符为新解密字符，否则新解密字符就是刚才的 PlainStr对应位置的字 符，各个解密字符合并就是被 KEY最后一个字符的 Asc码解密过的字符串，并取代 PlainStr。 第三步：循环第二步，依次用 KEY的其余倒序字符按第二步方法执行，得到最后的PlainStr。 第四步：经过以上三步的操作， PlainStr字符串就经过钥匙字串 KEY的解密。 示例代码如下： ‘****************************************************************************** ‘ 加密解密算法 ‘可见字符ASC码： 48-57(0-9);65-90(A-Z);97-122(a-z) ‘异或结果为可见字符则异或 ‘偶数则把异或结果分成两半各自并反序，增加破解难度
‘***********************************加密*************************************** Private Function Encrypt(PlainStr As String, key As String) as string Dim Char As String, KeyChar As String, NewStr As String, AscCode As Long Dim i As Integer, j As Integer, Side1 As String, Side2 As String For j = 1 To Len(key) ‘钥匙字符串正向逐个取字符，用其 Asc码和待加密字符串各字 符的 Asc码异或操作 NewStr = "" KeyChar = Mid(key, j, 1) For i = 1 To Len(PlainStr) ‘ 取待加密字符串各字符 Char = Mid(PlainStr, i, 1) AscCode = Asc(Char) Xor Asc(KeyChar) ‘ 对字符的 Asc码异或操作 If (AscCode <= 57 And AscCode >= 48) Or (AscCode <= 90 And AscCode >= 65) Or (AscCode <= 122 And AscCode >= 97) Then NewStr = NewStr & Chr(AscCode) ‘ 异或后的 Asc码是可见字符的 Asc码，则把异或结 果转成字符，加入异或结果字符串 Else NewStr = NewStr & Char ‘ 异或后的 Asc码是不可见字符的 Asc码，则把原先 字符加入异或结果字符串 End If Next i PlainStr = NewStr Next j If Len(PlainStr) Mod 2 = 0 Then ‘ 异或结果字符串，其长度为偶数则分左右两半并各自反 序 Side1 = StrReverse(Left(PlainStr, (Len(PlainStr) / 2))) Side2 = StrReverse(Right(PlainStr, (Len(PlainStr) / 2))) PlainStr = Side1 & Side2 ‘ 合并左右反序字符串 End If Encrypt = PlainStr ‘ 生成加密结果字符串 End Function ‘***********************************解密*************************************** Private Function Decrypt(PlainStr As String, key As String) as string Dim Char As String, KeyChar As String, NewStr As String, AscCode As Long Dim i As Integer, j As Integer, Side1 As String, Side2 As String If Len(PlainStr) Mod 2 = 0 Then ‘ 字符串为偶数长度，则分左右两半并各自反序 Side1 = StrReverse(Left(PlainStr, (Len(PlainStr) / 2))) Side2 = StrReverse(Right(PlainStr, (Len(PlainStr) / 2))) PlainStr = Side1 & Side2 ‘ 合并左右反序后字符串 End If For j = Len(key) To 1 Step -1 ‘反顺序逐个取钥匙字符串各字符，用其 Asc码和待解密 字符串各字符的 Asc码异或操作 NewStr = "" KeyChar = Mid(key, j, 1)
For i = 1 To Len(PlainStr) ‘ 对字符串每个字符的 Asc码进行异或 Char = Mid(PlainStr, i, 1) AscCode = Asc(Char) Xor Asc(KeyChar) ‘ 字符的 Asc码进行异或 If (AscCode <= 57 And AscCode >= 48) Or (AscCode <= 90 And AscCode >= 65) Or (AscCode <= 122 And AscCode >= 97) Then NewStr = NewStr & Chr(AscCode) ‘ 异或后的 Asc码是可见字符的 Asc码，则把异或结 果转成字符，加入异或结果字符串 Else NewStr = NewStr & Char ‘ 异或后的 Asc码是不可见字符的 Asc码，则把原先 字符加入异或结果字符串 End If Next i PlainStr = NewStr Next j Decrypt = PlainStr End Function 第四章 Excel VBA优化及结束语 第一节 Excel VBA优化 由于 Microsoft Office办公套件的广泛应用，以及该软件版本的不断提升，功能不断完善，在 Office 办公套件平匀上开发出的的 VBA应用程序越来越多，而 VBA是一种宏语言，在运行速度上有很大的限制。 因此 VBA编程的方法直接关系到VBA程序运行的效率，本节列举了一些提高VBA程序运行效率的方法。 方法1：尽量使用 VBA原有的属性、方法和Worksheet函数 由于 Excel对象多达百多个，对象的属性、方法、事件多不胜数，对于初学者来说可能对它们不全部 了解，这就产生了编程者经常编写与 Excel对象的属性、方法相同功能的 VBA代码段，而这些代码段的运 行效率显然与Excel对象的属性、方法完成任务的速度相差甚大。例如用 Range的属性 CurrentRegion来返 回Range 对象，该对象代表当前区。（当前区指以任意空白行及空白列的组合为边界的区域）。同样功能的 VBA代码需数十行。因此编程前应尽可能多地了解 Excel对象的属性、方法。 充分利用Worksheet函数是提高程序运行速度的极度有效的方法。如求平均工资的例子： For Each c In Worksheet(1).Range(″A1:A1000″) TotalV alue =TotalV alue＋ c.Value Next AverageValue = TotalValue / Worksheet(1).Range(″A1:A1000″).Rows.Count 而下面代码程序比上面例子快得多： AverageValue=Application.WorksheetFunction.Average(Worksheets(1).Range(″A1:A1000″)) 其它函数如 Count,Counta,Countif,Match,Lookup等等，都能代替相同功能的 VBA程序代码，提高程序 的运行速度。 方法2：尽量减少使用对象引用，尤其在循环中 每一个 Excel对象的属性、方法的调用都需要通过 OLE接口的一个或多个调用，这些OLE调用都是 需要时间的，减少使用对象引用能加快 VBA代码的运行。例如
1)．使用With语句。 Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Name=″Pay″ Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.FontStyle=″Bold″ … 则以下语句比上面的快 With Workbooks(1).Sheets(1).Range(″A1:A1000″).Font .Name = ″Pay″ .FontStyle = ″Bold″ … End With 2)．使用对象变量。 如果你发现一个对象引用被多次使用，则你可以将此对象用 Set 设置为对象变量，以减少对对象 的访问。如： Workbooks(1).Sheets(1).Range(″A1″).Value = 100 Workbooks(1).Sheets(1).Range(″A2″).Value = 200 则以下代码比上面的要快： Set MySheet = Workbooks(1).Sheets(1) MySheet.Range(″A1″).Value = 100 MySheet.Range(″A2″).Value = 200 3)．在循环中要尽量减少对象的访问。 For k = 1 To 1000 Sheets(″Sheet1″).Select Cells(k,1).Value = Cells(1,1).Value Next k 则以下代码比上面的要快： Set TheValue = Cells(1,1).Value Sheets(″Sheet1″).Select For k = 1 To 1000 Cells(k,1).Value = TheValue Next k 方法3：减少对象的激活和选择 如果你的通过录制宏来学习 VBA的，则你的 VBA程序里一定充满了对象的激活和选择，例如 Workbooks(XXX).Activate、 Sheets(XXX).Select、 Range(XXX).Select等,但事实上大多数情况下这些操作不 是必需的。例如 Sheets(″Sheet3″).Select Range(″A1″).Value = 100 Range(″A2″).Value = 200 可改为： With Sheets(″Sheet3″) .Range(″A1″).Value = 100 .Range(″A2″).Value = 200 End With
方法4：关闭屏幕更新 如果你的 VBA程序前面三条做得比较差，则关闭屏幕更新是提高 VBA程序运行速度的最有效的方法， 缩短运行时间2/3左右。关闭屏幕更新的方法： Application.ScreenUpdate = False 请不要忘记 VBA程序运行结束时再将该值设回来： Application.ScreenU pdate =Tr ue 方法5：变量类型确定,少用变体变量 Option Explicit 语句, 在模块级别中使用，强制显式堀明模块中的所有变量。 如果模块中使用了 Option Explicit，则必须使用 Dim、 Private、 Public、 ReDim 或 Static 语句来显式堀明所有的变量。如果 使用了未堀明的变量名在编译时间会出现错误。如果没有使用 Option Explicit 语句，一般所有未堀明的变 量都是 Variant 类型的。 注意 使用 Option Explicit 可以避免在键入已有变量时出错，在变量的范围不是很清楚的代码中使用 该语句可以避免混乱 . 方法6：关闭Excel系统提示 ‘本示例关闭所有打开的工作簿。如果某个打开的工作簿有改变， Microsoft Excel 将显示询问是否保存 更改的对话框和相应提示。 Workbooks.Close 实际开发程序时,需要关闭提示信息对话框,给用户简洁高效的体验. Application.DisplayAlerts = False ‘信息警告关闭 请不要忘记 VBA程序运行结束时再将该值设回来： Application.DisplayA lerts =Tr ue ‘信息警告开启 关闭信息警告后, 保存文档及关闭需要先保存,在关闭 Workbooks("filename.xls").Save ‘文件保存 Workbooks("filename.xls").Close SaveChanges:=True ‘文件关闭, 不出现是否要保存的窗口,并保存所有对此工作簿的更改。 Workbooks("BOOK1.XLS").Close SaveChanges:=False ‘本示例关闭 Book1.xls，并放弃所有对此工作簿的更改。 这样可以提高程序的简洁性,给用户服务 . 方法7: 提高关键代码和循环代码的效率 不同方法执行效率的差异，但千万不要因为追求效率而损失了代码的可读性、清晰性。效率的优化必 须是针对关键代码的优化，对于一些在程序执行过程中，只执行很少次数的代码，没有必要牺牲可读性而 进行优化。对于代码执行效率，千万不要人云亦云，必要时候，自己动手测试一下，结果往往会出 乎 意料。 代码执行时间的测算VBA和 VB中，没有专门的代码执行事件测算工具和方法，笔者一般是使用 Timer 函数，其返回值是一个 Single类型的数值，代表从午夜开始到现在经过的秒数，此数值包括小数部分，但 精确程度在Windows NT，2000和 XP下大概接近 10毫秒。如果要测试一段代码的执行速度，可以使用如 下方法： Sub MeasureTime() Dim Time1 As Single, Time2 As Single Dim TotalTime As Single
Dim Times As Long Dim i As Long Times = 10000 Time1 = Timer For i = 1 To Times Step 1 Mytest1 Next i Time2 = Timer TotalTime = (Time2 – Time1) * 1000 MsgBox "执行时间: " & TotalTime & " 毫秒（次数： " _ & Times & ")" End Sub SubMy test1() Dim i As Long Dim s As String i = Rnd s = Format(i, "#.00") End Sub 过程 MeasureTime可以测试一个过程的执行速度，因为一般一个过程执行会很快，所以使 用循环， 执行n次（第8行设置），在第 12行调用测试的过程，通过循环前的时间（第9行）和 循环后的时 间（第15行），计算总共执行时间（第17行）。使用这个方法，就可以做一些测试，看哪些方法执行效率 更高。另外，由于Windows的多任务特定，测试时最好关闭其他无关程序，以获得较准确的测试结果。 方法8 注意单元格写法 cells(1,1) >>>>> range("a1")>>>>.[a1] cells(1,1)符合 EXCEL 结构，最快 range("a1")有对象，稍稍慢 [A1] 写的快，运行慢 方法9 不要直呼其名 a= Worksheets(1).Name >>>>> a=Worksheets("Sheet1").name 方法10 少用 RANGE对象，可用数组取代，速度快 5-10倍， Test2就比 Test1快。 Sub Test1() Dim i As Long, j As Long, buf As Long For i = 1 To 10000 For j = 1 To 100 buf = Cells(i, j) N ext j Next i End Sub Sub Test2() Dim i As Long, j As Long, buf As Long, C As Variant
C =Range("A1:CV10000" ) For i = 1 To 10000 For j = 1 To 100 buf = C(i, j) N ext j Next i End Sub 方法11 注意函数的类型 , 尽量少用 Variant变量，多用整型变量，如多用整型变量函数。 Chr$ ChrB$ Command$ CurDir$ Date$ Dir$ Error$ Format$ Hex$ Input$ InputB$ LCase$ LeftB$ LTrim$ Mid$ MidB$ Oct$ Right$ RightB$ RTrim$ Space$ Str$ String$ Time$ Trim$ UCase$ 这些字符型函数 就比chr date space 等快，因为不加后缀类型指定的函数，其返回值是 Variant类型结 果。 第二节 结束语 经过一礼拜的疲劳（没功劳有苦劳，没苦劳总有疲劳，套一句《疯狂石头》的电影对白） ，我总算结 束了开始的计划，也算是有头有尾，稍感欣慰。这期间，我要感谢各位 VBA爱好者的鼓励和支持，你们 的坚持浏览让我有信心继续写下去，让我感到我写的还有点用（不是瞎写、乱写的，无乱灌水之嫌疑）。 我对程序开发，以前学过很多东西，可以说是陪着一些计算机开发语言发展走过一段时间的。记得 96 年大学时，我们学汇编语言，那时觉得像天文；觉得难，就学习 Foxbase数据库，记得考计算机二级时， 我上机得了满分，一下子有信心了，就转而学习 VB5，但学来学去，就是没法突破，后来硕士期间，我学 会了 VB6，解决了一个实际问题，这下对 VB6开发及程序开发，有了更深刻的理解；但还是觉得VB6没 能有好的办法解决计算机复杂的问题，比如矢量图的绘制和保存，我就一直搞不会。后来东看西看，学了 很多计算机东西。读博士期间，用 Excel解决数据计算和作图，由于是要重复作类似的，所以学下了 VBA， 突然发现 Excel VBA是很适合我这种使用者—需要快速解决工作学习的实际问题， 由此我也开发了世界一 流的地化数据投图软件Geoplot，关于它的论文发表在 Computers & Geosciences上。在开发这个软件期间， 学了很多东西，这些核心的东西我都在这个论坛发过贴了。所以，我隆重推荐大家学习 VBA，由于它是入 门，学习，进阶都很快速，很容易上手的，是解决实际工作的最佳工具（信不信由你！）。对于其它开发语 言，我认为目前的开发语言越来越一致了，都是以对象为核心，比如 VB.NET,VC++.NET等，所以学会一 种 VB.NET就可以解决其它开发问题，但普通用户来讲，是不需要学会和精通那些的，只要知道有它们的 存在，且找一本书学一下，如果真的有机会，有事情需要用到那些，再学习。因为大家都很忙，所以建议 学习 VBA这种快速解决问题的工具，看我的内容，估计一个礼拜就学会了，再看看论坛上的贴子，我想 大家一个月就能成为 VBA中级人员。程序开发，其实还需要一定天赋的，因为核心的算法是要靠一定智 慧的，不同的人，搞出来的，虽然都解决问题，但速度差异很大等。 想到那就写到那，胡言乱语。宗旨就是建议大家学些VBA，它是一种快速上手和能用到实际中解决问 题的工具软件。
本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/risslin/archive/2009/12/31/5111401.aspx
旅游不在乎终点，而是在意途中的人和事还有那些美好的记忆和景色。
