- Excel 2010 VBA编程与实践
- 罗刚君 章兰新 黄朝阳编著
- 1776字
- 2020-08-27 02:13:48
1.4 提升代码的兼容性
编写程序通常有自用和他人使用两种状况。如果程序是他人使用，那么就存在不同用户使用不同版本带来的兼容性问题。本节展示如何让自己的程序可以在多个不同版本中兼容的思路，读者可以借鉴。
疑难19 程序的兼容性体现在哪些方面
如果编写自定义函数或者开发的插件发送给不确定用户使用，且不能限制其使用指定的 Office 版本和Windows版本，那么就一定存在代码兼容性问题。通常兼容性问题体现在哪些方面呢？
解决方案
操作系统不同、Office版本不同将带来兼容性问题，不同用户处理的对象不同，例如图形对象个数不同、单元格区域大小不同等，在使用相同代码处理不同对象时也一定会产生兼容性问题。本例从三方面进行分析。
操作方法
※ 操作系统对VBA的影响 ※
不同操作系统对VBA是有影响的。例如Windows 2000、XP和7中API函数有部分不同；由于桌面主题不同造成对所有窗口的宽度也不同，那么设计需要严格计算边距与高度的窗体时就会产生偏差；部分程序的参数也不同，例如Windows 2000中DOS命令的“CD”命令不支持“CD/D”这个参数，而XP开始，以后的各种操作系统都支持；最后是Windows中一些默认程序也有变化。例如Windows 2000和XP都有“Outlook Express”，而Vista和Windows 7中删除了该程序，所以操作系统的版本也对VBA调用邮件程序有着极大的影响。
如果需要在执行主体程序前判断当前操作系统的版本，以当前常用的四大操作系统Windows 2000、XP、Vista和7为例，判断操作系统的方式如下：
Sub 当前系统()
MsgBox WorksheetFunction.HLookup(Split(Application.OperatingSystem, " ")(UBound(Split(Application.OperatingSystem, " "))),
[{"5.0","5.01","6.0","6.01";"WIN 2000","WIN XP","VISTA","WIN7"}], 2, 0)End Sub
执行程序后，将在对话框中告知当前操作系统版本名称。Windows 2000、XP、Vista和7的版本号分别对应5.0、5.01、6.0、6.01。
而对于Office版本不同带来的兼容性问题则远远多于Windows版本带来的兼容性问题。例如：
· 工作表函数不同：每次版本更新都会加入新的函数。当VBA中使用该函数后，程序在低版本中就无法运行。
· 单元格行列数不同：Excel 2007以前的版本有65536行×256列，而Excel 2007和2010有1048576行×16384列。调用单元格时会产生兼容性问题。
· VBA中的对象有增减：例如Excel 2007开始增加了图标集、色阶条件格式，VBA中也相应地增加对象和方法。那么调用这些新对象的代码在2007以前的版本一定会出错；而Excel 2003所具备的FileSearch属性也从Excel 2007版开始删除了，通常在新版中利用DIR方法来替代FileSearch进行文件搜索。
· 对部分内置方法进行修改、完善：例如Excel 2007开始对早期版本的排序Sort做了修改，新版的Sort和早期版本完全不兼容；对于定义名称Name也有不同的处理方式，从Excel 2007开始可以对名称添加备注，而早期版本无此属性。
· 颜色不同：Excel 2003的单个工作簿可以使用的颜色数量是56种（索引颜色），而Excel 2007开始采用43亿种（32位真彩色）。对颜色的处理，在 Excel 2003中通常采用ColorIndex，而鉴于ColorIndex本身的限制，它无法准确地体现Excel 2007的颜色值，所以为了体现兼容属性，通常改用 Color。例如获取单元格的颜色编码，那么必须使用以下代码才具有兼容性：
MsgBox ActiveCell.Interior.Color
除了以上版本差异带来的兼容性问题外，不同用户在同一版本中使用同一程序时也会有兼容性问题。因为不同用户制表时会有不同习惯，标题行数不同，或者待汇总的工作表数量不同、路径不同等，那么在开发工具时，为了体现兼容性，通常不使用硬编码，而用动态引用方式，使代码可以适应变化。
例如多表汇总，虽然工作表名称是“Sheet1”、“Sheet2”、“Sheet3”，但仍然不使用“Sheet1”方式引用工作表，而是“Sheets(1)”，即通过索引号调用工作表，避免改名后程序出错；而对于单元格的引用也不使用“[A1:c20]”这种硬编码，而是“ActiveSheet.Usedrange”实现动态调用，适应数据的增减变化。对于文件路径，也不能使用“d:\生产表”这种明文方式，而是调用对话框让用户自由选择，从而大大提升程序的兼容性，保证在不同环境下都可以正确执行。
原理分析
VBA程序的使用对象不确定时，操作系统环境、Office环境和工作表对象不同都会产生兼容性问题。实际工作中避免这种问题的方法只有两种：通过IF判断当前环境，再根据环境执行不同的代码；而对于不确定的文件路径、工作表对象和区域地址等，通过动态引用来适应变化。
知识扩展
开发通用性的工具时，所有工作表名、单元格地址、图形对象都不能使用硬编码引用，而改用索引号或者 UsedRange 、CurrentRegion 这类具有自动适应区域变化的属性，否则数据、路径变化时程序无法通用，会增加维护成本。
疑难20 如何让程序适应不确定对象
同一个程序在不同时候使用，其需要处理的对象是不同的。那么如何才能让程序通用呢？即程序可以适应环境的变化。例如图1-32所示的“一班”、“二班”、“三班”和“四班”的A1:D13区域存放各班级的成绩表。要求将各班成绩合并到“总表”中，并将工作簿另存为“已合并”，代码如下：
Sub 合并所有工作表()
'新建工作表，命名为“总表”
With Sheets.Add(after:=Sheets(Sheets.Count)).Name = "总表"
End With
'合并4个班级的成绩
Sheets("一班").[a1:d13].Copy Sheets("总表").Cells(Rows.Count, 1).End
(xlUp)
Sheets("二班").[a2:d13].Copy Sheets("总表").Cells(Rows.Count, 1).End
(xlUp).Offset(1, 0)
Sheets("三班").[a2:d13].Copy Sheets("总表").Cells(Rows.Count, 1).End
(xlUp).Offset(1, 0)
Sheets("四班").[a2:d13].Copy Sheets("总表").Cells(Rows.Count, 1).End
(xlUp).Offset(1, 0)
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\已合并.xlsm", xlOpenXML
WorkbookMacroEnabled
End Sub
█ 图1-32 成绩表
以上程序可以完成需求，然而通用性极差，如何修正可以使其适应各种变化呢？
解决方案
对所有可能出现的错误、冲突都进行判断，并将硬编码的区域引用改为动态引用。包括创建工作表前判断“总表”是否存在、让用户自行选择标题行数、动态引用工作表、动态引用已用区域、另存文件前判断当前表是否保存等。从所有可能产生影响的方面进行防范，避免环境变化时程序需要重新编写。
操作方法
步骤1 对以上程序加入防错语句，以及将静态引用修改为动态引用，完整代码如下：
Sub 合并所有工作表2() '通过6个方面完善程序，使其具有通用性
Dim i As Integer, sht As Worksheet, Bt As Integer '声明变量
'如果当前工作簿已经是“已合并”则退出程序
If ActiveWorkbook.Name = "已合并.xlsm" Then Exit Sub
On Error Resume Next
'手法1：创建工作表中判断是否具有同名工作表，避免出错
Set sht = Sheets("总表") '将“总表”赋予变量
If err <> 0 Then '如果出错（表示不存在“总表”），
With Sheets.Add(after:=Sheets(Sheets.Count)) '新建工作表命名为“总表”
.Name = "总表"
End With
Else
Sheets("总表").Move Sheets(Sheets.Count) '否则，将原有的“总表”移至最后
Sheets("总表").Cells.Clear '手法2：如果已有总表，清除其原有数据，避免多重合并
End If
'手法3：让用户选择标题行数，避免标题变化时，无法正确地引用正文区域
Bt = Application.InputBox("标题行数为：", "请指定标题行数", 1, , , , , 1)
If Bt > 0 And Bt < 10 Then '如果标题行数在1到10之间，则执行复制
Sheets(1).Rows("1:" & Bt).Copy Sheets("总表").[a1] '先复制标题到总表
'手法4：利用Sheets.Count计算待汇总工作表数量，避免班级数量变化或者工作表名变化
'时引用出错
For i = 1 To Sheets.Count - 1 '循环“总表”以外的所有工作表
'手法5：如果非空表则复制，否则跳过
If Not IsEmpty(Sheets(i).UsedRange) Then '如果工作表为非空表
'再复制正文数据到“总表”中。复制数据时忽略标题行
Intersect(Sheets(i).UsedRange, Sheets(i).UsedRange.Offset
(Bt, 0)).Copy _
Sheets("总表").Cells(Rows.Count, 1).End(xlUp).Offset
(1, 0)
End If
Next i
'手法6：判断当前工作簿是否保存过。如果没有则让用户选择保存路径，否则另存到
'当前文件同路径下。避免文件未保存时出错
If Len(Dir(ActiveWorkbook.Path, vbDirectory)) <2 Then '如果工作簿没有保存过
With Application.FileDialog(msoFileDialogFolderPicker)
'显示打开文件夹的对话框
If .Show = -1 Then '如果选择了文件夹，则将当前工作簿移到该文件中
ActiveWorkbook.SaveAs .SelectedItems(1) & IIf(Right$
(.SelectedItems(1), 1) = "\", "", "\") & "\已合并.xlsm",
xlOpenXMLWorkbookMacroEnabled
End If
End With
Else '否则当前工作簿另存到当前工作簿同路径下，工作簿名为“已合并.xlsm”
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\已合并.xlsm",
xlOpenXMLWorkbookMacroEnabled
End If
End If
End Sub
步骤2 将光标定位于代码中任意位置，按【F5】键执行代码，程序首先会弹出图1-33所示的对话框让用户确认成绩表的标题行数。然后将“总表”以外的工作表数据除标题行外全部复制到“总表”中，如图1-34所示。如果活动工作簿已保存过，那么会将活动工作簿另存到同路径下，且命名为“已合并.xlsm”；如果未保存过则会弹出对话框让用户选择路径。
█ 图1-33 确定标题行数
█ 图1-34 合并各班成绩
原理分析
如果 VBA 代码仅需当前使用一次即可，那么编程时不需要考虑通用性。反之则需要对各种不同的意外状况进行防错，避免数据变化时程序出错。所谓意外状况，通常包括文件夹路径不存在、待创建的文件名已经存在、工作表数据行列数增减、引用的待计算区域为空白、待排序区域具有合并单元格等，在程序中应该对每个方面都加以判断，并对可能产生的意外设置进行处理。通过本例，读者可以大致了解将普通程序提升为通用程序的常规思路。
本例中DIR语句用于判断工作簿是否保存，如果保存过，DIR方法从FullName中获取的文件名的长度一定大于0。
知识扩展
※ 使用动态区域引用让代码具有更强的通用性 ※
常见的区域动态引用包括“UsedRange”（已用区域），“CurrentRegion”（当前区域），“Cells(Rows.Count, 1).End (xlUp)”（第一列最后一行非空行），“Selection”（当前选择的区域）。在开发通用型程序时，特别是加载宏，尽量使用动态引用，而“Range("a1:b20")”或者“[c:d]”之类引用则兼容性极差，不能适应数据变化。对于工作表的引用，为了体现通用性，均采用索引号方式，例如“sheets(1)”代表第一个工作表，而不能使用第一个工作表的实际名称。对于文件夹的动态引用，最好的方式是让用户从对话框中选择，防止指定的路径不存在。
疑难21 如何让程序兼容Excel多版本
Excel目前最常用的3个版本是Excel 2003、2007和2010，如何让自己的程序可以兼容多个版本呢?例如 Excel 新版本相对2003增加了行列数、增加了 Sort 对象强化排序、增加了去重复值功能、去除了FileSearch对象、对单元格颜色大大改进等，如何让程序在Excel 2003、2007和2010中都可以顺利执行呢？
解决方案
为了体现兼容性，通常采用3种思路：一是让程序自动判断Excel版本变化后的实际数据，例如行列数变化；二是写两段代码，让程序根据当前Excel版本调用对应的一段代码；三是使用低版本的方式，因为通常低版本Excel无法使用高版本Excel的部分功能，但高版本可以调用低版本的代码。
操作方法
步骤1 对于行列数不同引起的兼容性问题，可以利用动态引用的方式处理。Excel 2003及早期版本是65536行×256列，Excel 2007和2010是1048576行×16384列，那么在引用最后一个非空行时，通常采用[a65536].end(xlup)和[a1048576].end(xlup)。然而，两种引用方式都不能在多个版本中兼容，正确的引用方式如下。
· cells(rows.Count,1)：第一列最后一个非空单元格。其中rows.Count用于计算总行数，可以随Excel的版本变化而变化，相对于65536和1048576有更大的通用性。
· cells(1,columns.Count)：第一行最后一个非空单元格。其优点同上。
步骤2 对于排序，Excel 2003及早期版本使用Sort方法，而从Excel 2007开始增加了一个Sort对象。Sort对象比Sort方法功能更强大，但无法在Excel 2003及早期版本中使用。所以为了兼容性，可以如下方式处理：
Sub 排序() '根据版本号执行不同代码
Dim rng As Range
Set rng = ActiveSheet.UsedRange '将当前表已用区域赋予变量rng
'根据版本号执行对应的排序代码，Excel 2007的版本号是12，Excel 2010的版本号是14
If Application.Version * 1 < 12 Then GoTo line1 Else GoTo line2
line1: '2007以前的版本使用
rng.Offset(1, 0).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:
=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal
Exit Sub
line2: 'Excel 2007和2010专用
With ActiveSheet.Sort '利用排序对象进行排序
.SortFields.Clear '清除原有的SortFields对象，该对象存储了排序状态
.SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=
xlAscending, DataOption:=xlSortNormal '添加排序条件
.SetRange rng '设置排序的区域为rng
.Orientation = xlTopToBottom '排序方向为纵向
.Apply '根据当前应用的排序状态对区域进行排序
End With
End Sub
步骤3 对于查找重复值，Excel 2007和2010有专用的RemoveDuplicates方法实现，而Excel 2003及更早的版本只能通过高级筛选完成。那么为了通用性，同样可以采取步骤2相同的思路。代码如下：
Sub 消除重复值() '根据版本号执行不同代码
Dim rng As Range
Set rng = Range([a1], Cells(Rows.Count, 1).End(xlUp)) '将A列所有已用单元
格赋值给变量rng
If Application.Version * 1 < 12 Then GoTo line1 Else GoTo line2
'根据版本号执行对应的排序代码
line1: '2007以前的版本使用（虽然2007和2010也可以使用，但效率不如Remove Duplicates
方法）
With rng
'高级筛选不重复值，将它保存在最后一列
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1,
Columns.Count), Unique:=True
.Clear '清除原有数据
Cells(1, Columns.Count).CurrentRegion.Copy .Item(1)
'将筛选后的不重复值复制到A列
Cells(1, Columns.Count).CurrentRegion.Delete '清除辅助区数据
End With
Exit Sub '退出过程，避免执行Line2
line2: 'Excel 2007和2010专用
Intersect(rng, rng.Offset(1, 0)).RemoveDuplicates Columns:=1, Header:
=xlNo '取不重复值
End Sub
步骤4 Excel 2007以前的版本有FileSearch对象，可以方便地进行文件查找；Excel 2007及2010删除了该功能，但可以利用DIR实现相同功能。本例通过DIR方法完成文件查找，替代FileSearch对象，且代码在所有版本中通用：
Sub 查找文件() 'DIR替代FileSearch对象实现文件查找
Dim 路径 As String, 文件对象 As String, 文件名称 As String
路径 = "D:" '搜索D盘文件
文件对象 = "*.*" '搜索所有文件
文件名称 = Dir(路径& "\" &文件对象) '获取文件名
Do '开始循环，直到
Range("A" & i + 1) =文件名称 '将找到的文件名写入A列单元格
文件名称= Dir '查找其他文件
i = i + 1
Loop Until 文件名称 = ""
End Sub
步骤5 Excel 2007开始对单元格的可用颜色从56种升级到43亿种，在Excel 2003中可以使用ColorIndex来表示所有颜色值，但对于Excel 2007和2010则远远不足。如果利用ColorIndex获取或者设置单元格背景，大部分情况下会产生颜色偏差。例如将A1:A5的背色复制到B1:B5，使用以下代码在Excel中完全可行，但在新版中则部分正确、部分错误，如图1-35所示。
Sub 复制颜色()
For i = 1 To 5
Cells(i, 2).Interior.ColorIndex = Cells(i, 1).Interior.ColorIndex
Next
End Sub
█ 图1-35 复制颜色
如果需要让程序兼容多版本，那么可以将代码中“ColorIndex”修改为“Color”。“Color”所能引用的颜色值不像“ColorIndex”那样受限于56种，而且对每个版本都通用。
原理分析
微软公司在升级Office时，总是采取向下兼容的方式，即早期版本无法使用新版本的部分功能，但新版本通常可以使用早期版本的所有功能，少数例外。所以为了让程序通用于多个版本，可以一律采用早期版本的代码来使程序提升兼容性。但为了新版用户能使用新功能，则可以通过Application.Version判断当前用户的Excel版本，根据版本号执行对应的代码。而对于有替代方法的，如Color替代ColorIndex和DIR替代FileSearch，则通过替代方式让程序通用于多版本。
知识扩展
※ 识别Excel的版本号 ※
Application.Version用于判断Excel程序的版本号，Excel 2002是10.0，Excel 2003是11.0，Excel 2007是12.0，而Excel 2010跳过了13.0，版本号为14.0。
也有一些对象或者属性是Excel 2003之后的版本才提供的，在Excel 2003中不可使用，也不存在替代品，那么唯一做法是判断版本号，小于12.0则在提示用户后直接退出程序。
疑难22 如何让程序兼容英文和中文系统
假设只有英文和简体中文两种需求，如何实现VBA程序在英文系统中执行时显示英文，而在中文系统中执行则显示中文?。
解决方案
利用API函数判断当前计算机的语言系统，在需要显示文字时，根据实际语言调用不同的语句。与疑难21中兼容Excel多版本时采用相同思路。
操作方法
步骤1 编写一个判断操作系统语言的自定义函数，其值为布尔值，代码如下：
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long Function language() As Boolean '开发一个语言函数，用于判断当前操作系统是否为英文language = (GetSystemDefaultLCID = &H409) End Function
步骤2 以创建名为“Summation”的工作表为例，如果在创建表时发现有同名工作表，那么需要提示用户，该提示需要自动适应当前系统的语系。那么在弹出对话框前需要调用language函数：
Sub NewSheet() '创建新工作表，名为“Summation”
Dim sht As Worksheet
On Error Resume Next
Set sht = Sheets("Summation") '将工作表“Summation”赋予变量
If Err <> 0 Then '如果有错误（表示不存在“Summation”工作表）
Sheets.Add after:=Sheets(Sheets.Count) '那么在最末处新建一个工作表
Sheets(Sheets.Count).Name = "Summation" '改名为“Summation”
Else '否则
If language Then '如果系统是英文，则用英文提示用户
MsgBox "There has been one worksheet named “Summation”"
Else '否则用中文提示（中英文系统由函数计算得来）
MsgBox "已经有名为“Summation”的工作表"
End If
End If
End Sub
步骤3 光标置于代码中任意位置并按【F5】键执行，如果当前工作簿已经存在“Summation”工作表，将会弹出对话框提示用户。如果用户操作系统是中文，那么对话框如图1-36所示；如果用户操作系统是英文，则对话框如图1-37所示。
█ 图1-36 中文提示
█ 图1-37 英文提示
原理分析
※ 利用API函数识别简体、繁体中文与英文 ※
“kernel32.dll”文件位于“系统盘符:\Windows\System32”下，它是一个动态链接库文件，属于内核级文件。它控制着系统的内存管理、数据的输入/输出操作和中断处理，集成了很多系统相关的 API 函数，GetSystemDefaultLCID 属于其中之一，用于判断操作系统的语系。其中GetSystemDefaultLCID值为“&H404”时表示系统为繁体中文，值为“&H804”时表示系统为简体中文，而值为“&H409”时表示系统为英文。
知识扩展
本例中演示的对话框为中英文切换，如果用户窗体中的控件的“Caption”属性也需要中英文切换的话，可以利用窗体的Activate事件对控件的“Caption”属性进行控制。例如：
Me.CommandButton1.Caption = IIf(language, "OK", "确定")
疑难23 如何让程序兼容简体与繁体中文
如何实现VBA程序在简体中文系统和繁体中文系统中打开时分别显示简体中文和繁体中文，而不是乱码？
解决方案
利用API函数GetSystemDefaultLCID判断当前操作系统的语言是简体中文还是繁体中文，然后根据语系执行不同的语句。
操作方法
步骤1 编写一个判断操作系统语言的自定义函数，其值为布尔值，代码如下：
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long Function language() As Boolean '开发一个语言函数，用于判断当前操作系统是否为繁 体中文 language = (GetSystemDefaultLCID = &H404) End Function
步骤2 以在状态栏显示主机开机后到现在的使用时间为例，调用函数 language 判断当前操作系统语言是简体中文还是繁体中文，然后调用对应的代码，在状态栏显示开机时间，代码如下：
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub 状态栏显示电脑使用时间() '自动适应简繁体
Application.OnTime Now + TimeValue("00:00:10"), "状态栏显示电脑使用时间"
'每10秒钟更新一次
If language Then '如果是繁体
Application.StatusBar = "您的電腦已使用" & Round(GetTickCount / 1000
/ 60, 0) & "分鐘"
Else '否则
Application.StatusBar = "您的电脑已使用" & Round(GetTickCount / 1000
/ 60, 0) & "分钟"
End If
End Sub
API函数的声明语句必须置于模块的顶部，所以以上两段代码中的两句API声明应排在所有过程前面。代码见光盘文件夹“第1章”中的案例文件“疑难23.xlsm”。
步骤3 执行过程“状态栏显示电脑使用时间”，如果当前系统语言是简体中文，那么状态栏效果如图1-38所示；如果当前系统语言是繁体中文，那么状态栏效果如图1-39所示。
█ 图1-38 简体显示开机时间
█ 图1-39 繁体显示开机时间
原理分析
※ 让代码适应简体与繁体系统 ※
API 函数 GetSystemDefaultLCID 获取的系统语言编码“&H404”代表繁体中文，“&H804”代表简体中文。本例中通过判断系统语系执行不同的代码来实现简繁兼容。不过根据笔者的经验，在简体系统中编写繁体的代码在繁体操作系统中打开会显示乱码，而在繁体系统中编写的简体代码和繁体代码都可以在简体系统中正常执行。所以需要代码简繁通用时，可以在繁体操作系统中书写代码，其中简体部分利用Office的简繁转换功能转换为简体即可。
知识扩展
如果需要让窗体中各种控件显示的字符也自动适应简繁系统，那么可以在窗体的 Activate事件中调用language函数，让显示的文字可以适应操作系统的语系。