EXCEL宏编程实例

Excel 宏编程举例说明 学习宏编程 需要 VB 基础 如果一点 VB 基础和面向对象的概念 建议先去补补 VB 不然即使自认 为学好了也只能拿着高射炮打蚊子 一 宏学习 首先需要明确的是 本文不可能教会您关于宏的所有内容 您需要学会利用 录制宏 的方法来学 习宏 点击 Excel 工具 下拉菜单中 宏 下 quot 录制新宏 此后可象平时一样进行有关操作 待完 成后停止录制 然后再点击 工具 下拉菜单中 宏 下 宏 的 编辑 选项即可打开刚才所录制的宏的 Visual Basic 源程序 并且可以在此时的 帮助 下拉菜单中获得有关的编程帮助 对录制宏进行修改 不仅可以学习宏的使用 还能大大简化宏的编写 二 基本概念 为了学习 Excel 中的宏 我们需要先了解以下一些基本概念 1 工作簿 Workbooks Workbook ActiveWorkbook ThisWorkbook Workbooks 集合包含 Excel 中所有当前打开的 Excel 工作簿 亦即所有打开的 Excel 文件 Workbook 对应 Workbooks 中的成员 即其中的 Excel 文件 ActiveWorkbook 代表当前处于活动 状态的工作簿 即当前显示的 Excel 文件 ThisWorkbook 代表其中有 Visual Basic 代码正在运行的 工作簿 在具体使用中可用 Workbooks index 来引用 Workbook 对象 其中 index 为工作簿名称或编 号 如 Workbooks 1 Workbooks 年度报表 xls 而编号按照创建或打开工作簿的顺序来确定 第一个打开的工作簿编号为 1 第二个打开的工作簿为 2 2 工作表 Worksheets Worksheet ActiveSheet Worksheets 集合包含工作簿中所有的工作表 即一个 Excel 文件中的所有数据表页 而 Worksheet 则代表其中的一个工作表 ActiveSheet 代表当前处于的活动状态工作表 即当前显示的 一个工作表 可用 Worksheets index 来引用 Worksheet 对象 其中 index 为工作表名称或索引号 如 Worksheets 1 Worksheets 第一季度数据 工作表索引号表明该工作表在工作表标签中的位置 第一个 最左边的 工作表的索引号为 1 最后一个 最右边的 为 Worksheets Count 需要注意 的是 在使用过程中 Excel 会自动重排工作表索引号 保持按照其在工作表标签中的从左至右排列 工作表的索引号递增 因此 由于可能进行的工作表添加或删除 工作表索引号不一定始终保持不变 3 图表 Chart Charts ChartObject ChartObjects ActiveChart Chart 代表工作簿中的图表 该图表既可为嵌入式图表 包含在 ChartObject 中 也可为一个 分开的 单独的 图表工作表 Charts 代表指定工作簿或活动工作簿中所有图表工作表的集合 但不包括嵌入式在工作表或对话 框编辑表中的图表 使用 Charts index 可引用单个 Chart 图表 其中 index 是该图表工作表的索引 号或名称 如 Charts 1 Charts 销售图表 图表工作表的索引号表示图表工作表在工作簿的工作 表标签栏上的位置 Charts 1 是工作簿中第一个 最左边的 图表工作表 Charts Charts Count 为 最后一个 最右边的 图表工作表 ChartObject 代表工作表中的嵌入式图表 其作用是作为 Chart 对象的容器 利用 ChartObject 可以控制工作表上嵌入式图表的外观和尺寸 ChartObjects 代表指定的图表工作表 对话框编辑表或工作表上所有嵌入式图表的集合 可由 ChartObjects index 引用单个 ChartObject 其中 index 为嵌入式图表的编号或名称 如 Worksheets Sheet1 ChartObjects 1 Worksheets sheet1 ChartObjects chart1 分别对应 Sheet1 工作表中的第一个嵌入式图表 以及名为 Chart1 的嵌入式图表 ActiveChart 可以引用活动状态下的图表 不论该图表是图表工作表 或嵌入式图表 而对于图 表工作表为活动工作表时 还可以通过 ActiveSheet 属性引用之 4 单元格 Cells ActiveCell Range Areas Cells row column 代表单个单元格 其中 row 为行号 column 为列号 如可以用 Cells 1 1 Cells 10 4 来引用 A1 D10 单元格 ActiveCell 代表活动工作表的活动单元格 或指定工作表的 活动单元格 Range 代表工作表中的某一单元格 某一行 某一列 某一选定区域 该选定区域可包含一个或 若干连续单元格区域 或者某一三维区域 可用 Range arg 来引用单元格或单元格区域 其中 arg 可为单元格号 单元格号范围 单元格 区域名称 如 Range A5 Range A1 H8 Range Criteria 虽然可用 Range A1 返回单 元格 A1 但用 Cells 更方便 因为此时可用变量指定行和列 可将 Range 与 Cells 结合起来使用 如 Range Cells 1 1 Cells 10 10 代表单元格区域 A1 J10 而 expression Cells row column 返回单元格区域中的一部分 其中 expression 是返回 Range 的表 达式 row 和 column 为相对于该区域的左上角偏移量 如由 Range C5 C10 Cells 1 1 引用单元 格 C5 Areas 为选定区域内的连续单元格块的集合 其成员是 Range 对象 而其中的每个 Range 对象 代表选定区域内与其它部分相分离的一个连续单元格块 某些操作不能在选定区域内的多个单元格块 上同时执行 必须在选定区域内的单元格块数 Areas Count 上循环 对每个单独的单元格块分别执行 该操作 此时 可用 Areas index 从集合中返回单个 Range 对象 其中 index 为单元格块编号 如 Areas 1 5 行与列 Rows Columns Row Column Rows Columns 分别代表活动工作表 单元格区域范围 Range 指定工作表中的所有行数 列 数 对于一个多选单元格区域范围 Range 的 Rows Columns 只返回该范围中第一个区域的行数 列数 例如 如果 Range 对象有两个区域 areas A1 B2 和 C3 D4 Rows Count 返回 2 而不是 4 可通过 Rows 行号 Columns 列号 来引用相应的行与列 如 Rows 3 Columns 4 分别对应 第三行 D 列 利用 Rows Column 可以获得区域中第一块的第一行行号 第一列列号 所得值均以十进制数表示 三 处理单元格 1 直接赋值与引用 将变量 常量值直接赋给单元格 或将单元格的值直接赋给变量 常量 这是在 Excel 中最简单 的单元格赋值及引用方法 如下例将工作表 Sheet1 A1 单元格的值赋给 Integer 变量 I 并将 I 1 的 值赋给当前工作表中的 B1 单元格 Dim I As Integer I Worksheets Sheet1 Cells 1 1 Cells 1 2 Select 选定 B1 单元格 使其成为当前单元格 ActiveCell I 1 以 I 1 为当前单元格赋值 2 用公式赋值 在宏的使用中 可能会更多地用公式来给单元格赋值 如下例将相对于活动单元格左侧第 4 列 向上第 6 行至向上第 2 行的单元格数值之和赋给活动单元格 以本行 本列为第 0 行 0 列 ActiveCell Formula AVERAGE R 6 C 4 R 2 C 4 3 引用其它工作表中的单元格 当赋值公式中需要引用其它工作表中的单元格时 在被引用的单元格前加上 工作表名 即可 如以下即在赋值中引用了 Sheet1 工作表中的 A1 至 A4 单元格 Range E10 Formula SUM Sheet1 R1C1 R4C1 但需注意的是 当被引用的工作表名中含有某些可能引起公式歧义的字符时 需要用单引号 将工 作表名括起来 如 Worksheets Sheet1 ActiveCell Formula Max 1 1 剖面 D3 D5 4 引用其它工作簿中的单元格 在被引用单元格所在工作表名前加上 工作簿名 即可引用其它工作簿中的单元格 如 ActiveCell Formula MAX Book1 xls Sheet3 R1C RC 4 同样需注意的是 当被引用的工作簿名中含有某些可能引起公式歧义的字符时 需要用中括号 及单引号 将工作簿名括起来 如 Cells 1 2 Formula MIN 1995 2000 总结 xls 1995 1996 年 A 1 A 6 5 避免循环引用 在上述公式赋值过程中 应避免在公式中引用被赋值的单元格 防止循环引用错误 6 添加批注 可按如下方法格给单元格添加批注 Dim 批注文本 As String 批注文本 批注示例 准备批注文本 ActiveCell AddComment 添加批注 ActiveCell Comment Text Text 临时 写入批注文本 ActiveCell Comment Visible False 隐藏批注 7 添加 删除 复制 剪切 粘贴单元格 Range D10 Insert Shift xlToRight 在 D10 单元格处添加一新单元格 原 D10 格右移 Range C2 Insert Shift xlDown 在 C2 单元格处添加一新单元格 原 C2 格下移 Rows 2 EntireRow Insert 在第 2 行前添加一空白行 原第 2 行下移 Columns 3 EntireColumn Insert 在 C 列前添加一空白列 原 C 列右移 Columns A D Delete Shift xlToLeft 删除 A 列至 D 列 其右侧列左移 Rows 3 5 Delete Shift xlUp 删除第 3 行至第 5 行 其下方行上移 Range B2 EntireRow Delete 删除第 2 行 Range C4 EntireColumn Delete 删除 C 列 Range B10 C13 Copy 复制 B10 至 C13 单元格区域 Cells 1 2 Cut 剪切 B1 单元格 Range D10 Select ActiveSheet Paste 自 D10 单元格起粘贴剪贴板中的内容 四 图表 1 工作表图表 以下为一添加工作表图表的实例 Charts Add after Worksheets Sheet1 在 Sheet1 工作表之后添加新图表工作表 ActiveChart ChartType xlXYScatterSmooth 图表类型为 XY 平滑线散点图 ActiveChart SetSourceData Source Sheets 结点坐标 Range A1 B69 PlotBy xlColumns 图表数据来源于 结点坐标 工作表的 A1 至 B69 单元格 且按列绘图 ActiveChart Location Where xlLocationAsNewSheet With ActiveChart HasTitle True ChartTitle Characters Text 节点坐标 图表标题 节点坐标 Axes xlCategory xlPrimary HasTitle True Axes xlCategory xlPrimary AxisTitle Characters Text x x 轴标题 x Axes xlValue xlPrimary HasTitle True Axes xlValue xlPrimary AxisTitle Characters Text y y 轴标题 y End With With ActiveChart Axes xlCategory HasMajorGridlines True 显示 x 轴主网格线 默认情况下为显示 HasMinorGridlines True 显示 x 轴次网格线 默认情况下为不显示 End With With ActiveChart Axes xlValue HasMajorGridlines True 标出 x 轴主网格值 默认情况下为标注 HasMinorGridlines False 取消 x 轴次网格值标注 默认情况下为不标注 End With ActiveChart Legend Position xlRight 图例显示在图表右侧 2 嵌入式图表 嵌入式图表仅在添加方式及引用格式上与工作表图表有所不同 而对图表的设置基本类似 详见 下例 Set 嵌入表 ActiveSheet ChartObjects Add 0 0 200 300 在当前工作表 0 0 坐标处添加宽 200 高 300 的嵌入式图表 嵌入表 Chart ChartType xlColumnClustered 图表类型为簇状柱形图 嵌入表 Chart SetSourceData Source Sheets 1 Range A2 B2 PlotBy xlRows 设置图表 数据来源 With 嵌入表 Chart HasTitle False 无图表标题 Axes xlCategory xlPrimary HasTitle False 无 x 轴标题 Axes xlValue xlPrimary HasTitle False 无 y 轴标题 End With 五 工作表 1 添加 Sheets Add before Sheets 1 在第 1 工作表前添加新工作表 Sheets Add after Sheets Sheets Count 在最后工作表后添加新工作表 2 移动 ActiveSheet Move before Sheets 2 将当前工作表移动至第 2 工作表之前 3 命名 ActiveSheet Name 工作表名 将当前工作表命名为 工作表名 4 删除 可以用以下语句删除当前工作表 ActiveSheet Delete 但在删除前 Excel 会自动弹出提示框 需在用户确认后方可执行删除 为避免这一干扰 可以先 用以下语句关闭 Excel 的警告提示 Application DisplayAlerts False 在删除完成后 再重新打开 Excel 的警告提示 Application DisplayAlerts True 六 工作簿 Excel 的宏对工作簿的操作主要为保存 Dim 存盘文件名 As String ActiveWorkbook Save 保存当前工作簿 存盘文件名 工作表名 ActiveWorkbook SaveAs Filename 存盘文件名 当前工作簿另存为 工作表名 xls 在另存时 若指定的存盘文件名不包含路径 则保存在该工作簿的打开目录下 而若此存盘文件 已存在 也可用关闭 Excel 警告提示的方法以免其自动弹出提示框 64 用过 VB 的人都应该知道如何声明变量 在 VBA 中声明变量和 VB 中是完全一样的 使用 Dim 语句 Dim a as integer 声明 A 为整形变量 Dim a 声明 A 为变体变量 Dim a as string 声明 A 为字符串变量 Dim a b c as currency 声明 A b c 为货币变量 声明变量可以是 Byte Boolean Integer Long Currency Single Double Decimal 当前 不支持 Date String 只限变长字符串 String length 定长字符串 Object Variant 用户定义类型或对象类型 强制声明变量 Option Explicit 说明 该语句必在任何过程之前出现在模块中 声明常数 用来代替文字值 Const 常数的默认状态是 Private Const My 456 声明 Public 常数 Public Const MyString HELP 声明 Private Integer 常数 Private Const MyInt As Integer 5 在同一行里声明多个常数 Const MyStr Hello MyDouble As Double 3 4567 在 EXCEL97 中 有一个十分好的功能 他就是把鼠标放置在一个有效数据单元格中 执行该段 代码 你就可以将连在一起的一片数据全部选中 只要将该段代码加入到你的模块中 Sub My Select Selection CurrentRegion Select End sub 删除当前单元格中数据的前后空格 sub my trim Trim ActiveCell Value end sub 使单元格位移 sub my offset ActiveCell Offset 0 1 Select 当前单元格向左移动一格 ActiveCell Offset 0 1 Select 当前单元格向右移动一格 ActiveCell Offset 1 0 Select 当前单元格向下移动一格 ActiveCell Offset 1 0 Select 当前单元格向上移动一格 end sub 如果上述程序产生错误那是因为单元格不能移动 为了解除上述错误 我们可以往 sub my offset 之下加一段代码 on error resume next 注意以下代码都不再添加 sub 代码名称 和 end sub 请自己添加 给当前单元格赋值 ActiveCell Value 你好 给特定单元格加入一段代码 例如 在 单元格中插入 Range a1 value hello 又如 你现在的工作簿在 sheet1 上 你要往 sheet2 的 单元格中插入 1 sheets sheet2 select range a1 value hello 或 2 Sheets sheet1 Range a1 Value hello 说明 1 sheet2 被打开 然后在将 HELLO 放入到 A1 单元格中 2 sheet2 不被打开 将 HELLO 放入到 A1 单元格中 隐藏工作表 隐藏 SHEET1 这张工作表 sheets sheet1 Visible False 显示 SHEET1 这张工作表 sheets sheet1 Visible True 有时候我们想把所有的 EXCEL 中的 SHEET 都打印预览 请使用该段代码 它将在你现有的工作簿中 循环 直到最后一个工作簿结束循环预览 Dim my As Worksheet For Each my In Worksheets my PrintPreview Next my 得到当前单元格的地址 msgbox ActiveCell Address 得到当前日期及时间 msgbox date chr 13 time 保护工作簿 ActiveSheet Protect 取消保护工作簿 ActiveSheet Unprotect 给当前工作簿改名为 liu ActiveSheet Name liu 打开一个应用程序 AppActivate Shell C WINDOWS CALC EXE 增加一个工作簿 Worksheets Add 删除当前工作簿 activesheet delete 打开一个文件 Workbooks Open FileName C My Documents Book2 xls 关闭当前工作簿 ActiveWindow Close 当前单元格定为 左对齐 Selection HorizontalAlignment xlLeft 当前单元格定为 中心对齐 Selection HorizontalAlignment xlCenter 当前单元格定为 右对齐 Selection HorizontalAlignment xlRight 当前单元格为百分号风格 Selection Style Percent 当前单元格字体为粗体 Selection Font Bold True 当前单元格字体为斜体 Selection Font Italic True 当前单元格字体为宋体 20 号字 With Selection Font Name 宋体 Size 20 End With With 语句 With 对象 描述 End With 让你的机器发出响声 BEEP 清除单元格中所有文字 批注 格式 所有的东西 ActiveCell Clear 测试选择状态的单元格的行数 MsgBox Selection Rows Count 测试选择状态的单元格的列数 MsgBox Selection Columns Count 测试选择状态的单元格的地址 Selection Address 让所有的错误不再发生 ON ERROR RESUME NEXT 产生错误时让错误转到另一个地方 on error goto l code l code 删除一个文件 kill c 1 txt 定制自己的状态栏 Application StatusBar 现在时刻 Time 恢复自己的状态栏 Application StatusBar false 在运行期执行一个宏 Application Run macro text 滚动窗口到 a1 的位置 ActiveWindow ScrollRow 1 ActiveWindow ScrollColumn 1 定制系统日期 Dim MyDate MyDay MyDate 12 12 69 MyDay Day MyDate 今天的年限 Dim MyDate MyYear MyDate Date MyYear Year MyDate MsgBox MyYear 产生一个 inputbox InputBox Enter number of months to add 得到一个文件名 Dim kk As String kk Application GetOpenFilename EXCEL XLS XLS Title 提示 请打开一个 EXCEL 文 件 msgbox kk 打开 zoom 显示比例对话框 Application Dialogs xlDialogZoom Show 激活字体对话框 Application Dialogs xlDialogActiveCellFont Show 打开另存对话框 Dim kk As String kk Application GetSaveAsFilename excel xls xls Workbooks Open kk 此段代码寻找字符串中特定字符的位置 需要建立一个窗体 并在窗体中 放入 TEXTBOX1 TEXTBOX2 和 TEXTBOX3 3 个文本框 及 COMMANDBUTTON1 按钮 Private Sub CommandButton1 Click a TextBox1 Text b TextBox2 Text aa Len a i 1 Dim YY As String If b Then Exit Sub Do If InStr i a b vbTextCompare 0 Then Exit Do kk InStr i a b vbTextCompare YY YY CStr kk i kk 1 Loop While aa i TextBox3 Text YY End Sub ActiveX 控件在 Excel97 中的运用 Excel97 在工作表或图表上可使用 ActiveX 控件 根据我使用的体会 在工作上处理控件时 必 须注意和了解如下事项 一 用 Excel5 0 95 工作簿文件格式保存 Excel97 工作簿时 将选择 ActiveX 控件信息 当用户通过双击鼠标来编辑内嵌在其它应用程序文档中的 Excel97 工作簿 时 该工作簿上的控件将不会正常工作 如果用户是通过用右键单击工作簿 然后选中快捷菜单上的 打开 命令来编辑工作簿的话 工作簿上的控件就能正常工作了 二 当 ActiveX 控件处于激活状态时 将禁用某些 MicrosoftExcelVisualBasic 方法和属性 例如 当某一控件激活时 就不能使用 Sort 方法 故下述按钮单击事件处理过程中的代码将失败 因为用户 单击按钮后 该按钮就处于激活状态 PrivateSubCommandButton1 Click Range a1 a10 SortKey1 Range a1 EndSub 解决办法是通过选激活工作表上其它元素的方法来绕过这种问题 例如 可用下列代码对单元格 区域排序 PrivateSubCommandButton1 Click Range a1 Activate Range a1 a10 SortKey1 Range a1 CommandButton1 Activate End Sub 三 在 MicrosoftExcel 中 用 OLEObjects 集合中的 OLEObject 对象代表 ActiveX 控件 如果要 用编程的方式向工作表添加 ActiveX 控件 可用 OLEObjects 集合的 Add 方法 例如向第一张工作 表添加命令按钮 Worksheets 1 OLEObjects Add Forms CommandButton 1 Left 10 Top 10 Height 20 Width 100 因为 ActiveX 控件也可用 OLEObjects 集合中的 OLEObject 对象代表 所以也可用该集合中的 对象来设置控件的属性 例如要设置控件 CommandBotton1 的 左边位置 属性 Worksheets 1 OLEObjects CommandButton1 Left 10 那些不属于 OLEObject 对象属性的控件属性 可通过由 Object 属性返回的实际控件对象来设置 例如要设置控件 CommandButton1 的标题 Worksheets 1 OLEObjects CommandButton1 Object Caption runme 因为所有的 OLE 对象也是 Shapes 集合的成员 所以也可用该集合设置若干控件的属性 例如要 对齐第一张工作表上所有控件的左边框 ForEachsInWorksheets 1 Shapes Ifs Type msoOLEControlObjectThens Left 10 Next 请注意 当在控件所在工作表的类模块之外使用控件的名称时 必须用工作表的名称限定该控件 的名称 在工作表上 ActiveX 控件的事件处理过程中 Me 关键字所指向的是工作表 而非控件 在 Excel 中利用 VBA 创建多级选单 Excel 是我们常用的报表处理软件之一 对于大多数人来说只是使用它进行打印报表 没有注意其他 功能 其实利用 Excel 内嵌的 VBA 语言完全可以快速开发出自己企业的应用系统来 而且应用系统 界面与其它专业编程语言相当相似 下面笔者简单通过一个实例说明如何利用 VBA 创建多级选单 首先 我们对 Excel 中两个重要的内置函数 auto open 和 auto close 作一简单说明 auto open 在打开工作簿时系统将自动执行该函数 因此我们可以在该函数中调用自己应用程序 的选单函数以及其它需要初始化设置的函数及宏语句 auto close 在关闭工作簿时系统将自动执行该函数 所以我们需要在该函数中放置删除用户自定 义选单语句 否则只有退出 Excel 才能恢复 EXCEL 的系统选单 在以下语句中 我们定义了选单设置函数 OpenMyMenu 用于设置多级选单 其他有关说明见程 序内注释 详细代码如下 Sub OpenMyMenu 自定义多级选单函数 On Error Resume Next 忽略错误 MenuBars MyMenu Delete 删除自定义选单 MenuBars Add MyMenu 自定义选单项 Sheets sheet1 Select MenuBars MyMenu Menus Add Caption 金融 增加第一个选单项 金融 以下三句为在 金融 选单下增加 银行法 货币政策和条例 三项选单项 MenuBars MyMenu Menus 金融 MenuItems Add Caption 银行法 OnAction 银行法 MenuBars MyMenu Menus 金融 MenuItems Add Caption 货币政策 OnAction 货币 政策 MenuBars MyMenu Menus 金融 MenuItems Add Caption 条例 OnAction 条例 以下为创建如图所示的多级选单 MenuBars MyMenu Menus Add Caption 经济 建立选单项 经济 以下三句为在 经济 选单下增加 农业 工业和第三产业 三项选单项 MenuBars MyMenu Menus 经济 MenuItems Add Caption 农业 OnAction 农业 MenuBars MyMenu Menus 经济 MenuItems Add Caption 工业 OnAction 工业 MenuBars MyMenu Menus 经济 MenuItems AddMenu Caption 第三产业 以下三句为在 第三产业 选单下增加 概况 范畴 二项选单项和 饮食服务业 子选单 MenuBars MyMenu Menus 经济 MenuItems 第三产业 MenuItems Add Caption 概况 OnAction 概况 MenuBars MyMenu Menus 经济 MenuItems 第三产业 MenuItems Add Caption 范畴 OnAction 范畴 MenuBars MyMenu Menus 经济 MenuItems 第三产业 MenuItems AddMenu Caption 饮食服务业 以下二句为在 饮食服务业 选单下增加 酒店 1 酒店 2 二项选单项 MenuBars MyMenu Menus 经济 MenuItems 第三产业 MenuItems 饮食服务业 MenuItems Add Caption 酒店 1 OnAction 酒店 1 MenuBars MyMenu Menus 经济 MenuItems 第三产业 MenuItems 饮食服务业 MenuItems Add Caption 酒店 2 OnAction 酒店 2 MenuBars MyMenu Activate 激活自定义选单 End Sub Sub auto open 系统自动打开运行宏 OpenMyMenu 调用用户选单函数 End Sub Sub auto close 系统自动关闭运行宏 On Error Resume Next 忽略错误 MenuBars MyMenu Delete 删除自定义选单 End Sub 读者可以在自己的工作簿选单 工具 中的 宏 下 创建以上三个函数并将以上函数语句拷贝到其 中即可运行 66 用 VBA 编程 保护 Excel 文档 VBA Visual Basic for Application 是 Excel 应用程序中功能非常强大的编程语言 为了规范 不同的用户对 Excel 应用程序的访问能力 需要对 Excel 文档及有关的数据进行有效的保护 这里根 据自己及同行们的体会 从以下二个方面介绍用 VBA 编程法实现对 Excel 文档的保护 对工作簿的保护 1 利用 VBA 中 Workbook 对象的 SaveAs 方法实现对工作簿的保护 下面就对 SaveAs 有 关的参 量作一介绍 Filename 该字符串表示要保存的文件名 可包含完整路径 如果不指定路径 Microsoft Excel 将文件保存到当前文件夹 FileFormat 可选 文件的保存格式 Password 为一个区分大小写的字符串 不超过 15 个字符 用于指定文件的保护密码 WriteResPassword 该字符串表示文件的写保护密码 如果文件保存时带有密码 但打开文件时 不输入密码 则该文件以只读模式打开 ReadOnlyRecommended 如果为 True 则在打开文件时显示一条信息 提示该文件以只读模式打 开 下例就是在 Excel 应用程序中添加一工作簿 将工作簿按常规文件格式存为 C pj obj 经济评价 xls 文件 并给该文件指定保护密码 12 以及写保护密码 23 Sub 保护工作簿 NewWorkbook Workbooks add NewWorkbook SaveAs FileName C pj obj 经济评价 xls FileFormat XlNormal Password 12 WriteResPassword 23 End sub 2 利用 VBA 中 Workbook 对象的 Protect 方法对工作簿的结构和窗口进行保护 Workbook 对象的 Protect 方法带有以下三个参量 Password 为加在工作表或工作簿上区分大小写的密码字符串 如果省略本参数 不用密码就可以 取消对该工作簿的保护 否则 取消对该工作表或工作簿的保护时必须提供该密码 如果忘记了密码 就无法取消对该工作表或工作簿的保护 最好在安全的 地方保存一份密码及其对应文档名的列表 Structure 若为 True 则保护工作簿结构 工作簿中工作表的相对位置 默认值为 False Windows 若为 True 则保护工作簿窗口 下例就是对一名为 经济评价 xls 的工作簿实现 结构 和 窗口 保护 Sub 保护工作簿 Workbooks 经济评价 Protect Password 1234 Structure True Windows True End sub Workbook 对象的 Unprotect 方法用于取消对工作簿的保护 Unprotect 方法只有一个参量 就是 保护工作表时所用的口令 3 对工作簿进行隐藏保护 可使他人无法看到其对应的窗口 操作方法如下 在 VBA 中使用 Workbook 对象下面的 Windows 对象的 Visible 属性对工作簿进行隐藏和取消隐藏 Visible 属性的值可取 True 和 False 两种 下面程序代码完成对工作簿 book xls 的隐藏 Sub 隐藏工作簿 Workbooks book Activate ActiveWindow Visible False End sub 或 Sub 隐藏工作簿 Workbooks book Windows 1 Visible False End sub 对工作表的保护 1 对工作表实现口令保护利用 VBA 调用 Worksheet 对象的 Protect 方法对工作表进行保护 Protect 带有以下参量 Password 用于保护工作表的口令 Drawingobjects 若为 True 则对工作表中的 Drawingobjects 对象进行保护 缺省值为 True Contents 若为 True 则对单元格内容进行保护 缺省值为 True 下面程序代码完成对工作表 基础数据表 的保护 Sub 保护工作表 Worksheets 基础数据表 Protect Password 1234 End sub 2 对工作表实现隐藏保护 使他人无法看到工作表 利用 VBA 设置 Worksheet 对象的 Visible 属性来隐藏工作表 Visible 属性的值为以下三个值中的一 个 True 工作表为显示状态 False 工作表为隐藏状态 XlVerHidden 工作表为隐藏状态 且用户不能通过 取消隐藏 对话框将其改为显示状态 当 Visible 的值为 XlVerHidden 时 只能利用 VBA 将其重新设置为 True Sub 隐藏工作表 Worksheets 基础数据表 Visible False End sub 67 求 将所选区域中的数值全部转化为 万元 的最简代码 求 将所选区域中的数值全部转化为 万元 的最简代码 或能完成此功能的最便捷的命令操作 写了一个 抛砖引玉 Sub convt Dim cel As Range Dim dec As Variant Application EnableEvents False yesorno MsgBox 确实将区域所有数值转换为 万元 vbYesNo vbQuestion vbDefaultButton1 If yesorno vbYes Then 1 dec Application InputBox 请输入小数位数 Default 0 Type 1 If dec Then GoTo 1 End If For Each cel In Selection If IsNumeric cel Value Then cel Round cel Value 10000 2 万元 cel Round cel Value 10000 dec End If Next ElseIf yesorno vbNo Then Exit Sub End If End Sub 以下当为最简代码吧 Sub Macro2 Selection NumberFormatLocal End Sub 68 在 VBA 开发环境中 点击工具 附加控件 出现如下窗口 在可选控件中选择 microsoft orogressbar control 再点击确定 这时 你会发现在你的工具箱中增 加了进度条工具 如图 下面说说进度条的用法 属性 Max 设置进度条控件的最大值 Min 设置进度条控件的最小值 Value 设置进度条控件对象的当前值 Scrolling 进度条的式样 即一格一格的进度条或是没有间隔的进度条 例子 Private Sub UserForm Activate For i 1 to 5000 ProgressBar1 Max 5000 设置进度条控件的最大值 ProgressBar1 Value I 进度条控件对象的当前值 next End Sub 在程序中加入进度条的办法是将 ProgressBar1 Max 最大值 ProgressBar1 Value 当前值放入循 环中去 69 Excel 是一个优秀的电子表格软件 如果你编的程序需要以报表的形式显示最终结果 它会是个 不错的选择 你可以通过 VB 控制 Excel 显示数据表格 如果你不愿意深入了解 Excel 这些琐碎的细 节 也不是没有权宜之计 你可以打开 Excel 中的工具 宏 录制新宏 然后进行手工操作 结束后 把所录的宏代码贴进你的 VB 程序就行 这样得到的程序一般都能正常运行 但其中的宏代码往往不 够简洁 效率和可读性都不高 Excel 编程碰到的第一个问题是表头 有时表头的形式比较复杂 需要横向或纵向合并单元格 请放心 只要没有斜杠 Excel 都能应付得了 例如合并 A2 A5 这 4 个单元格 你录制的宏代码会是这样 Range A2 A5 Select With Selection HorizontalAlignment xlCenter VerticalAlignment xlBottom WrapText False Orientation 0 AddIndent False ShrinkToFit False MergeCells False End With Selection Merge 而自己编程只要一句 Range A2 A5 mergecells True 就可以解决问题 表头形式定了 再就是表头的内容 如果单元格中的文本长度超过了列宽 往往只能显示部分内 容 行尾那一格的内容则会 越境 进入右边那个空白单元格 很不美观 这个问题可以通过在程序 中设置列宽加以解决 Columns 14 columnwidth 12 设置第 14 列列宽为 12 缺省列宽为 8 38 如果你不愿意劳神去逐列估计实际所需的列宽 干脆来一行 Columns a i autofit a 到 i 列自动调整列宽 让 Excel 随机应变吧 但也许你不喜欢这种方法 认为表头撑大了列宽 弄得浏览一张小表格还得向右滚动 太不方便 了 要是能保持默认列宽 让文本自动换行就好了 没问题 Excel 包你满意 Rows 3 WrapText True 让第三行各单元格中的文本自动换行 不过你最好再加一句 Rows 3 VerticalAlignment xlTop 让表头自动向上对齐 这样比较符 合习惯 你还可以给表头打上底色 让你的读者不至于看了打哈欠 Rows 2 Interior ColorIndex 5 设置第 2 行底色为蓝色 再给表格的标题上色 这样更醒目一点 Rows 1 Font ColorIndex 4 表头完成后该填数据了 一个一个地填实在是太 如果你的数据是存放在一个二维数组中 那 问题就简单多了 Dim Data 3 4 数据处理 Range a2 d4 Value Data 这样可以一次填入一个表的所有数据 够快了吧 不过提醒一句 Range 对象大小最好与数组 匹配 小了无法显示所有数据 大了则会在空白单元格只填入 N A 表示没有取得数据 如果需要在结果中显示多个同样规格的数据表 想在 Range 对象中加入循环变量 这也好办 Dim cell11 cell2 Dim Data 3 4 For I 1 to 40 数据处理 Set cell1 Worksheets Sheet1 Cells 5 I 4 1 Set cell2 Worksheets Sheet1 Cells 5 I 2 4 Worksheets Sheet1 Range cell1 cell2 value Data Next I 表格填完了 现在该打表格线了 以下几条语句可以满足你的要求 With Worksheets Sheet1 Range cell1 cell2 borders LineStyle xlContinuous weight xlThin End With 关于 workbooks 的问题 今天编了一段程序 想实现把不同工作簿中的工作表合并到同一个工作簿中 磕磕碰碰的算是完成了 但 有个小地方不甚明白 请帮忙分析一下 或指点一下迷津 Sub 如何合并工作簿至同一工作簿中 首先遍历指定文件夹下的所有 xls 文件 Application DisplayAlerts False Application ScreenUpdating False Dim i k totalR1 totalC1 totalR2 totalC2 As Integer Dim sr As FileSearch 定义一个文件搜索对象 Set sr Application FileSearch sr LookIn E xiehui 注意路径 换成你实际的路径 sr Filename xls 搜索所有文件 sr Execute 执行搜索 Cells Delete 表格清空 存入指定位置 也可以不存 For i 1 To sr FoundFiles Count Cells i 1 sr FoundFiles i 每一行第一列填写一个文件名 Next Workbooks Add ActiveWorkbook SaveAs Filename e 合并 xls 读取第 1 个文件 提取标题行 Workbooks Open sr FoundFiles 1 Range A1 EntireRow Copy 添加标题行 Workbooks 合并 xls Activate 不明白为什么加上路径名就不行执行呢 提示说运行时错误 9 下 标超界 但只加文件名就可以执行 Range A1 PasteSpecial xlPasteAll Application CutCopyMode False 顺次读取文件名 按取相应数据进行填充 For i 1 To sr FoundFiles Count Workbooks Open sr FoundFiles i totalR1 Range A1 CurrentRegion Rows Count totalC1 Range A1 CurrentRegion Columns Count Range Cells 2 1 Cells totalR1 totalC1 Copy Workbooks 合并 xls Activate totalR2 Range A1 CurrentRegion Rows Count Range Cells totalR2 1 1 Cells totalR2 1 1 PasteSpecial xlPasteAll Application CutCopyMode False Range A1 CurrentRegion EntireColumn AutoFilter Next i End Sub 上面显红色的命令行是我不懂的地方 就是如果在 workbooks 中加上路径名 就提示错误 如果去掉的 话 就没问题 不知道是什么原因