VBA常用代码解析(第十三讲)
vba 代码解释
vba 代码解释摘要：1.VBA 代码简介2.VBA 代码结构与基本语法3.VBA 常用对象与方法4.VBA 代码实例解析5.提高VBA 代码可读性与实用性正文：VBA（Visual Basic for Applications）是一种为Microsoft Office应用程序设计的编程语言。
在本文中，我们将介绍VBA代码的基本概念、结构、语法以及如何在实际应用中编写高效的VBA代码。
1.VBA 代码简介VBA代码是一种面向对象的编程语言，其基本语法与Visual Basic相似。
VBA代码主要用于Microsoft Office应用程序，如Excel、Word和PowerPoint等，以实现自动化任务和定制功能。
2.VBA 代码结构与基本语法VBA代码的结构主要包括模块、过程、函数和事件。
模块是VBA代码的组织单元，包含过程、函数和变量等。
过程是一段执行特定任务的代码，可以包含多个步骤。
函数是返回特定值的代码段，与过程类似，但通常不需要输入参数。
事件是响应特定操作的代码，如单击按钮或打开文件等。
VBA的基本语法包括以下几点：- 变量声明：使用Dim或Private关键字声明变量，如Dim myVar As Integer。
- 数据类型：VBA支持基本数据类型如Integer、Double、String等，以及自定义类型。
- 语句：VBA代码主要由赋值语句、条件语句、循环语句等组成。
- 函数：VBA提供了一系列内置函数，如求和函数Sum、平均值函数Average等。
- 对象与方法：VBA代码中，对象是实体，方法是操作对象的动作。
例如，Range对象的方法有Copy、Paste等。
3.VBA 常用对象与方法在VBA编程中，常用对象包括Range、Worksheet、Workbook等。
以下是一些常用对象的方法示例：- Range对象：- 方法：Copy、Paste、Find、Replace等。
- 示例：Range("A1").Copy，将A1单元格的值复制到剪贴板。
vba编程代码大全
vba编程代码大全VBA编程代码大全。
VBA（Visual Basic for Applications）是一种用于应用程序开发的编程语言，它可以帮助用户在Microsoft Office软件中自动化任务，提高工作效率。
在本文中，我们将为您介绍一些常用的VBA编程代码，帮助您更好地利用VBA来处理各种任务。
首先，让我们来看一些常用的VBA基础操作代码。
在VBA中，您可以使用MsgBox函数来显示消息框，例如：```vba。
MsgBox "Hello, World!"```。
这段代码将会在屏幕上显示一个包含"Hello, World!"的消息框。
除了MsgBox 函数，VBA还提供了InputBox函数来获取用户输入的数值或文本：```vba。
Dim userInput As String。
userInput = InputBox("Please enter your name:")。
```。
这段代码将会弹出一个输入框，等待用户输入姓名，并将用户输入的内容存储在userInput变量中。
接下来，让我们来看一些与Excel相关的VBA代码。
在Excel中，VBA可以帮助您自动化各种数据处理任务。
例如，您可以使用VBA来创建新的工作表，并向其中填充数据：```vba。
Dim ws As Worksheet。
Set ws = ThisWorkbook.Sheets.Add。
= "NewSheet"ws.Range("A1").Value = "Hello"```。
这段代码将会在当前工作簿中创建一个名为"NewSheet"的新工作表，并在A1单元格中填入"Hello"。
除了操作工作表，VBA还可以帮助您处理Excel中的图表。
例如，您可以使用VBA来创建新的图表，并向其中添加数据：```vba。
vba常用代码讲解学习
VBA常用代码excel 常用宏宏代码大全本示例为设置密码窗口 (1)If Application.InputBox("请输入密码：") = 1234 Then[A1] = 1 '密码正确时执行Else: MsgBox "密码错误，即将退出！" '此行与第2行共同设置密码End If本示例为设置密码窗口 (1)X = MsgBox("是否真的要结帐？", vbYesNo)If X = vbYes ThenClose本示例为设置工作表密码ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码ActiveSheet.Unprotect Password:=641112 '撤消工作表保护并取消密码'本示例关闭除正在运行本示例的工作簿以外的其他所有工作簿，并保存其更改内容。
For Each w In WorkbooksIf <> Thenw.Close SaveChanges:=TrueEnd IfNext w'每次打开工作簿时，本示例都最大化 Microsoft Excel 窗口。
Application.WindowState = xlMaximized'本示例显示活动工作表的名称。
MsgBox "The name of the active sheet is " &'本示例保存当前活动工作簿的副本。
ActiveWorkbook.SaveCopyAs "C:\TEMP\XXXX.XLS"'下述过程激活工作簿中的第四张工作表。
Sheets(4).Activate'下述过程激活工作簿中的第1张工作表。
Worksheets(1).Activate'本示例通过将 Saved 属性设为 True 来关闭包含本段代码的工作簿，并放弃对该工作簿的任何更改。
VBA常见代码分析
VBA常见代码分析概述VBA（Visual Basic for Applications）是一种Microsoft Office应用程序中常用的宏编程语言。
在使用VBA过程中，有一些常见的代码模式和用法，本文将对这些常见的VBA代码进行分析和讨论。
常见代码分析1. 循环代码在VBA中，循环是一种常见的代码结构，用于重复执行一段代码块。
常见的循环结构有以下几种：- For循环：通过指定初始值、结束值和每次迭代的增量，可以让代码块重复执行一定次数。
For循环：通过指定初始值、结束值和每次迭代的增量，可以让代码块重复执行一定次数。
- Do循环：通过在循环开始和结束之间设置条件判断语句，可以让代码块重复执行直到条件不满足为止。
Do循环：通过在循环开始和结束之间设置条件判断语句，可以让代码块重复执行直到条件不满足为止。
- While循环：通过在循环开始之前和循环体内设置条件判断语句，可以让代码块重复执行直到条件不满足为止。
While循环：通过在循环开始之前和循环体内设置条件判断语句，可以让代码块重复执行直到条件不满足为止。
- Foreach循环：用于遍历集合或数组中的元素，让代码块对每个元素执行一次。
Foreach循环：用于遍历集合或数组中的元素，让代码块对每个元素执行一次。
2. 条件语句在VBA中使用条件语句可以根据条件的成立与否执行相应的代码块。
常见的条件语句有以下几种：- If语句：用于根据条件的成立与否执行不同的代码块。
If语句：用于根据条件的成立与否执行不同的代码块。
- Select Case语句：用于根据变量的值执行不同的代码块。
Select Case语句：用于根据变量的值执行不同的代码块。
3. 错误处理在VBA中，处理错误是重要的一部分。
以下是一些常见的错误处理的方式：- On Error语句：用于定义出现错误时要采取的动作，可以结合`Resume`语句实现错误的处理和跳转。
On Error语句：用于定义出现错误时要采取的动作，可以结合`Resume`语句实现错误的处理和跳转。
VBA中常用函数的使用与实例解析
VBA中常用函数的使用与实例解析VBA（Visual Basic for Applications）是一种宏语言，用于在Microsoft Office应用程序中编写自定义的程序和宏。
VBA通过提供各种内建函数来增强其功能，这些函数可以用于处理数据、执行数学运算、操作字符串和日期等。
在本文中，将介绍VBA中的几个常用函数，并通过实例解析来展示其用法和功能。
1. InStr函数InStr函数用于在一个字符串中搜索子字符串，并返回子字符串第一次出现的位置。
其语法如下：InStr([start, ]string1, string2[, compare])其中start为可选参数，表示从字符串中的哪个位置开始搜索。
string1表示要在其中搜索的字符串，而string2表示要搜索的子字符串。
compare为可选参数，用于指定比较方式（例如大小写敏感或不敏感）。
如果比较参数未指定，则默认为比较敏感。
例如，假设有一个字符串"Hello, World!"，我们希望找到子字符串"World"第一次出现的位置。
可以使用以下代码：```VBADim str As StringDim position As Integerstr = "Hello, World!"position = InStr(str, "World")MsgBox position```运行上述代码，将返回值为8，即子字符串"World"第一次出现的位置。
2. Left函数Left函数用于从一个字符串的左侧提取指定长度的字符。
其语法如下：Left(string, length)其中string表示要进行提取的字符串，而length表示要提取的左侧字符的数量。
例如，假设有一个字符串"Welcome to VBA"，我们希望提取前6个字符。
VBA常用代码解析
EXCEL VBA常用代码解析Range对象是Excel应用程序中最常用的对象，一个Range对象代表一个单元格、一行、一列、包含一个或者更多单元格区域(可以是连续的单元格，也可以是不连续的单元格)中选定的单元格，甚至是多个工作表上的一组单元格，在操作Excel 内的任何区域之前都需要将其表示为一个Range对象，然后使用该Range对象的方法和属性。
▲001 单元格的引用方法在VBA中经常需要引用单元格或单元格区域区域，主要有以下几种方法。
001-1 使用Range属性VBA中可以使用Range属性返回单元格或单元格区域，如下面的代码所示。
Sub RngSelect()Sheet1.Range("A3:F6，B1:C5").SelectEnd Sub代码解析：RangeSelect过程使用Select方法选中A3:F6，B1:C5单元格区域。
Range属性返回一个Range对象，该对象代表一个单元格或单元格区域，语法如下：Range(Cell1，Cell2)参数Cell1是必需的，必须为A1 样式引用的宏语言，可包括区域操作符(冒号)、相交区域操作符(空格)或合并区域操作符(逗号)。
也可包括美元符号(即绝对地址，如“$A$1”)。
可在区域中任一部分使用局部定义名称，如Range("B2:LastCell")，其中LastCell为已定义的单元格区域名称。
参数Cell2是可选的，区域左上角和右下角的单元格。
运行RangeSelect过程，选中A3:F6，B1:C5单元格区域。
001-2 使用Cells属性使用Cells属性返回一个Range对象，如下面的代码所示。
Sub Cell()Dim icell As IntegerFor icell = 1 To 100Sheet2.Cells(icell，1).Value = icellNextEnd Sub代码解析：Cell过程使用For...Next语句为工作表中的A1:A100单元格区域填入序号。
Excel VBA常用代码及解释
Excel VBA常用代码及解释(1) Option Explicit解释：强制对模块内所有变量进行声明(2) Option Base 1解释：指定数组的第一个下标为1(3) On Error Resume Next解释：忽略错误继续执行VBA代码,避免出现错误消息(4) On Error GoTo 100解释：当错误发生时跳转到过程中的某个位置(5) On Error GoTo 0解释：恢复正常的错误提示(6) Application.DisplayAlerts=False解释：在程序执行过程中使出现的警告框不显示(7) Application.DisplayAlerts=True解释：在程序执行过程中恢复显示警告框(8) Application.ScreenUpdating=False解释：关闭屏幕刷新(9) Application.ScreenUpdating = True解释：打开屏幕刷新(10) Workbooks.Add()解释：创建一个新的工作簿(11) Workbooks(“book1.xls”).Activate解释：激活名为book1的工作簿(12) ThisWorkbook.Save解释：保存工作簿(13) ThisWorkbook.close解释：关闭当前工作簿(14) ActiveWorkbook.Sheets.Count解释：获取活动工作薄中工作表数(15) Active 解释：返回活动工作薄的名称(16) This 解释：返回当前工作簿名称(17) ThisWorkbook.FullName解释：返回当前工作簿路径和名(18) edRange.Rows.Count解释：当前工作表中已使用的行数(19) Rows.Count解释：获取工作表的行数(20) Sheets(Sheet1).Name= “Sum”解释：将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) 解释：添加一个新工作表在第一工作表前(22)ActiveSheet.MoveAfter:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count )解释：将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select解释：同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或 Sheets(1).Delete解释：删除工作表1(25) edRange.FormatConditions.Delete解释：删除当前工作表中所有的条件格式(26) Cells.Hyperlinks.Delete解释：取消当前工作表所有超链接(27) ActiveCell.CurrentRegion.Select选择当前活动单元格所包含的范围，等同于快捷键Ctrl+A(28) Cells.Select解释：选定当前工作表的所有单元格(29) Range(“A1”).ClearContents解释：清除活动工作表上单元格A1中的内容。
VBA字典用法集锦及代码详解
常见字典用法集锦及代码详解TongDog工作室常见字典用法集锦及代码详解2 前言凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。
有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。
凡是上过EH 论坛的想学习VBA 里面字典用法的，几乎都看过研究过northwolves 狼版主、oobird 版主的有关字典的精华贴和经典代码。
我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。
字典对象只有4个属性和6个方法，相对其它的对象要简洁得多，而且容易理解使用方便，功能强大，运行速度非常快，效率极高。
深受大家的喜爱。
本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料，希望大家能喜欢。
给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。
所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。
字典的简介字典（Dictionary ）对象是微软Windows 脚本语言中的一个很有用的对象。
附带提一下，有名的正则表达式（RegExp ）对象和能方便处理驱动器、文件夹和文件的（FileSystemObject ）对象也是微软Windows 脚本语言中的一份子。
字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key ）和它的项（Item ）联合组成。
就好像一本字典书一样，是由很多生字和对它们对应的注解所组成。
比如字典的“典”字的解释是这样的：“典”字就是具有唯一性的关键字，后面的解释就是它的项，和“典”字联合组成一对数据。
常用关键字英汉对照：Dictionary 字典字典的简介3 Key 关键字Item 项，或者译为 条目字典对象的方法有6个：Add 方法、Keys 方法、Items 方法、Exists 方法、Remove 方法、RemoveAll 方法。
VBA编程中的常用代码
***************** 定制模块行为 *****************Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有,仅对同一工程中其它模块有用,在宏对话框中不显示Option Compare Text '字符串不区分大小写Option Base 1 '指定数组的第一个下标为 1On Error Resume Next '忽略错误继续执行 VBA代码,避免出现错误消息On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置On Error GoTo 0 '恢复正常的错误提示Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示Application.ScreenUpdating=False '关闭屏幕刷新Application.ScreenUpdating=True '打开屏幕刷新Application.Enable.CancelKey=xlDisabled '禁用 Ctrl+Break 中止宏运行的功能Err.Clear '清除程序运行过程中所有的错误*********** 工作簿 ***********Workbooks.Add() '创建一个新的工作簿Workbooks("book1.xls").Activate '激活名为 book1的工作簿ThisWorkbook.Save '保存工作簿ThisWorkbook.close '关闭当前工作簿ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数 '返回活动工作薄的名称 '返回当前工作簿名称ThisWorkbook.FullName '返回当前工作簿路径和名称ActiveWindow.EnableResize=False '禁止调整活动工作簿的大小Application.Window.Arrange xlArrangeStyleTiled '将工作簿以平铺方式排列ActiveWorkbook.WindowState=xlMaximized '将当前工作簿最大化ThisWorkbook.BuiltinDocumentProperties(""Last Save Time")或 Application.Caller.Parent.Parent.BuiltinDocumentProperties(""Last Save Time") '返回上次保存工作簿的日期和时间ThisWorkbook.BuiltinDocumentProperties("Last Print Date")或 Application.Caller.Parent.Parent.BuiltinDocumentProperties(""Last Print Date") '返回上次打印或预览工作簿的日期和时间Workbooks.Close '关闭所有打开的工作簿ActiveWorkbook.LinkSources(xlExcelLinks)'返回当前工作簿中的第一条链接ActiveWorkbook.CodeNameThisWorkbook.CodeName '返回工作簿代码的名称ActiveWorkbook.FileFormatThisWorkbook.FileFormat '返回当前工作簿文件格式代码ThisWorkbook.PathActiveWorkbook.Path '返回当前工作簿的路径(注:若工作簿未保存,则为空)ThisWorkbook.ReadOnlyActiveWorkbook.ReadOnly '返回当前工作簿的读/写值(为 False)ThisWorkbook.SavedActiveWorkbook.Saved '返回工作簿的存储值(若已保存则为 False)Application.Visible = False '隐藏工作簿Application.Visible = True '显示工作簿注:可与用户窗体配合使用,即在打开工作簿时将工作簿隐藏,只显示用户窗体.可设置控制按钮控制工作簿可见*********** 工作表 ***********edRange.Rows.Count '当前工作表中已使用的行数Rows.Count '获取工作表的行数(注：考虑向前兼容性)Sheets(Sheet1).Name= "Sum" '将 Sheet1命名为 SumThisWorkbook.Sheets.Add Before:=Worksheets'添加一个新工作表在第一工作表前ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后Worksheets(Array("sheet1","sheet2")).Select '同时选择工作表 1和工作表 2Sheets("sheet1").Delete或 Sheets(1).Delete '删除工作表 1ActiveWorkbook.Sheets(i).Name '获取工作表 i的名称ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示,这种方法也可以用在其它方面进行相互切换,即相当于开关按钮ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings '切换工作表中的行列边框显示edRange.FormatConditions.Delete '删除当前工作表中所有的条件格式Cells.Hyperlinks.Delete '取消当前工作表所有超链接ActiveSheet.PageSetup.Orientation=xlLandscape或 ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName '在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName '将用户名放置在活动工作表的页脚ActiveSheet.Columns("B").Insert '在A 列右侧插入列,即插入 B 列ActiveSheet.Columns("E").CutActiveSheet.Columns("B").Insert '以上两句将 E 列数据移至 B 列,原 B 列及以后的数据相应后移ActiveSheet.Columns("B").CutActiveSheet.Columns("E").Insert '以上两句将 B列数据移至 D列,原 C列和 D列数据相应左移一列ActiveSheet.Calculate '计算当前工作表ThisWorkbook.Worksheets(""sheet1").Visible=xlSheetHidden '正常隐藏工作表,同在 Excel 菜单中选择""格式——工作表——隐藏"操作一样ThisWorkbook.Worksheets(""sheet1").Visible=xlSheetVeryHidden '隐藏工作表,不能通过在 Excel 菜单中选择""格式——工作表——取消隐藏"来重新显示工作表ThisWorkbook.Worksheets(""sheet1").Visible=xlSheetVisible '显示被隐藏的工作表ThisWorkbook.Sheets(1).ProtectContents '检查工作表是否受到保护ThisWorkbook.Worksheets.Add Count:=2, Before:=ThisWorkbook.Worksheets(2)或 ThisWorkbook.Workshees.Add ThisWorkbook.Worksheets(2), , 2 '在第二个工作表之前添加两个新的工作表ThisWorkbook.Worksheets(3).Copy '复制一个工作表到新的工作簿ThisWorkbook.Worksheets(3).Copy ThisWorkbook.Worksheets'复制第三个工作表到第二个工作表之前ThisWorkbook.ActiveSheet.Columns.ColumnWidth = 20 '改变工作表的列宽为 20 ThisWorkbook.ActiveSheet.Columns.ColumnWidth = ThisWorkbook.ActiveSheet.StandardWidth '将工作表的列宽恢复为标准值ThisWorkbook.ActiveSheet.Columns(1).ColumnWidth = 20 '改变工作表列 1的宽度为 20 ThisWorkbook.ActiveSheet.Rows.RowHeight = 10 '改变工作表的行高为 10ThisWorkbook.ActiveSheet.Rows.RowHeight = ThisWorkbook.ActiveSheet.StandardHeight '将工作表的行高恢复为标准值ThisWorkbook.ActiveSheet.Rows(1).RowHeight = 10 '改变工作表的行 1的高度值设置为 10 ThisWorkbook.Worksheets(1).Activate '当前工作簿中的第一个工作表被激活ThisWorkbook.Worksheets("Sheet1").Rows(1).Font.Bold = True '设置工作表Sheet1中的行1数据为粗体ThisWorkbook.Worksheets("Sheet1").Rows(1).Hidden = True '将工作表Sheet1中的行1隐藏ActiveCell.EntireRow.Hidden = True '将当前工作表中活动单元格所在的行隐藏注：同样可用于列。
vba常用代码大全
前言我们平时在工作表xx的公式xx常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBAxx不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。
而能在VBAxx直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。
第1.1例ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。
二、代码：Sub示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel")'返回69myNum2 = Asc("e")'返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解1、Sub示例_1_01()：宏程序的开始语句。
2、Dim myNum1%, myNum2%：变量myNum1和myNum2声明为整型变量。
也可以写为Dim myNum1 As Integer。
Integer变量存储为16位（2个字节）的数值形式，其范围为-32,768到32,767之间。
Integer的类型声明字符是百分比符号(%)。
3、myNum1 = Asc("Excel")：把Asc函数的值赋给变量myNum1。
Asc函数返回一个Integer，代表字符串中首字母的字符的ASCII代码。
语法Asc(string)必要的string（字符串）参数可以是任何有效的字符串表达式。
如果string中没有包含任何字符，则会产生运行时错误。
4、myNum2 = Asc("e")：把Asc函数的值赋给变量myNum2。
VBA实用代码
VBA实用代码VBA实用代码1.判断一个表的最后一行:i = Range("A65536").End(xlUp).Row2.取最后一列列号：m = Range("dz1").End(xlT oLeft).Column3.遍历工作簿中所有表i=1For Each m In Sheets '遍历每个工作表cells(i,1)= '取工作表名cells(i,2)=sheets().cells(1,1) '取工作表第一个单元格内容i=i+1next4.求某月天数Function tianshu(riqi As Date) As Bytetianshu = DateSerial(Year(riqi), Month(riqi) + 1, Day(riqi)) - riqiEnd Function'求月末日期Function yuemo(riqi As Date) As Dateyuemo = DateSerial(Year(riqi), Month(riqi) + 1, 0)End Function5.禁止别人运行Word程序的VBA代码禁止别人运行Word程序的VBA代码单击“工具→宏→宏…”命令，在弹出的对话模型中输入宏名“autoexec”，然后单击“创建”，在代码窗中输入如下内容，即可控制别人运行WORD：Sub autoexec()Dim psw As Stringpsw = inputbox("请输入密码：", "登录？")If psw = "elong" ThenApplication.ShowMeElsemsgbox "对不起，请您与本机主人联系!"Application.QuitEnd IfEnd Sub破解办法：(1)、禁止自运行宏、(2)、或者直接删除normal.dot模板文件即可。
(完整版)VBA字典用法集锦及案例代码详解
VBA字典用法集锦及案例代码详解dadaVBA字典用法集锦及案例代码详解前言凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。
有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。
凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。
我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。
字典对象只有4个属性和6个方法，相对其它的对象要简洁得多，而且容易理解使用方便，功能强大，运行速度非常快，效率极高。
深受大家的喜爱。
本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料，希望大家能喜欢。
给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。
所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。
字典的简介字典（Dictionary）对象是微软Windows脚本语言中的一个很有用的对象。
附带提一下，有名的正则表达式（RegExp）对象和能方便处理驱动器、文件夹和文件的（FileSystemObject）对象也是微软Windows脚本语言中的一份子。
字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。
就好像一本字典书一样，是由很多生字和对它们对应的注解所组成。
比如字典的“典”字的解释是这样的：“典”字就是具有唯一性的关键字，后面的解释就是它的项，和“典”字联合组成一对数据。
常用关键字英汉对照：2字典的简介Dictionary 字典Key 关键字Item 项，或者译为条目字典对象的方法有6个：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。
EXCEL-VBA编程常用代码
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 取消保护工作簿
注意以下代码都不再添加 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"赋到 sheet2 的 A1 单元格中。 隐藏工作表 '隐藏 SHEET1 这张工作表
VBA代码操作代码
VBA代码操作代码'VBE对象是根对象，表示在VBA编辑器中存在的所有对象的最上层对象'一 VBAproject对象: VBE编辑器中的工程'1 VBComponents对象：表示工程中所有的部件集合，包括Excel对象、窗体、模块、类模块。
'1) CodeModule 对象：表示部件中相关的代码'操作VBE需要做的工作'1 设置信任'excel2003中，工具--宏--安全性--可靠发行商，选中“信任对于...''excel2007和excel2010，开发工具--安全性--宏设置--选中'对...的信任''2 引用Option Explicit'1、返回模块的行数Sub 返回模块A中的总行数()MsgBoxThisWorkbook.VBProject.VBComponents('A').CodeModule.Coun tOfLinesEnd SubSub 返回过程test中的总行数()MsgBoxThisWorkbook.VBProject.VBComponents('A').CodeModule.Proc CountLines('test', vbext_pk_Proc)End SubSub 返回过程fe中开始行数()MsgBoxThisWorkbook.VBProject.VBComponents('A').CodeModule.Proc BodyLine('fe', vbext_pk_Proc)End Sub'vbext_pk_Get 指定一个返回属性值的过程'vbext_pk_Let 指定一个赋值给属性的过程'vbext_pk_Set 指定一个给对象设置引用的过程'vbext_pk_Proc 指定所有过程除了Property 过程'2 返回模块的内容Sub 返回过程fe中的所有代码()Dim 开始行数, 总行数WithThisWorkbook.VBProject.VBComponents('A').CodeModule 开始行数 = .ProcBodyLine('fe', vbext_pk_Proc)总行数 = .ProcCountLines('fe', vbext_pk_Proc)MsgBox .Lines(开始行数, 总行数)End WithEnd SubSub 返回第7行所在的过程名()MsgBoxThisWorkbook.VBProject.VBComponents('A').CodeModule.Proc OfLine(7, vbext_pk_Proc)End Sub'判断模块和过程是否存在Sub 判断A模块是否存在()On Error Resume NextIf ThisWorkbook.VBProject.VBComponents('c') Is Nothing ThenMsgBox 'B模块没有存在'ElseMsgBox 'B模块存在'End IfEnd SubSub 判断是否存在b过程()'On Error Resume NextDim 开始行数开始行数= ThisWorkbook.VBProject.VBComponents('A').CodeModule.Proc BodyLine('B', vbext_pk_Proc)If Err.Number = 35 ThenMsgBox '不存在B过程'ElseMsgBox '存在B过程'End IfEnd Sub'返回工程中所有部件名称Sub 显示部件列表()Dim x As ByteWith ThisWorkbook.VBProjectFor x = 1 To .VBComponents.CountCells(x + 1, 1) = .VBComponents(x).NameCells(x + 1, 2) = .VBComponents(x).TypeNext xEnd WithEnd SubOption Explicit'一添加模块、过程、代码'1 添加模块Sub 添加新模块B()WithThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdMod ule).Name = 'B'End WithEnd Sub' vbext_ct_ClassModule 将一个类模块添加到集合' vbext_ct_MSForm 将窗体添加到集合' vbext_ct_StdModule 将标准模块添加到集合'2 在模块中添加代码Sub 添加新过程()Dim sr, codesr = 'Sub ABC()' & vbCrLf & 'Msgbox ''测试添加代码''' & vbCrLf & 'End Sub''MsgBox srWithThisWorkbook.VBProject.VBComponents('B').CodeModule .AddFromString srEnd With'3 在模块中插入代码Sub 在B模块中的第3行插入一行代码()WithThisWorkbook.VBProject.VBComponents('B').CodeModule .InsertLines 3, 'sheets(1).Select'End WithEnd Sub'二删除模块、过程、代码'1 删除模块Sub 删除B模块()With ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents('B') End WithEnd Sub'2 删除过程Sub 删除B模块中的ABC过程()Dim 开始行数, 总行数WithThisWorkbook.VBProject.VBComponents('B').CodeModule 开始行数 = .ProcBodyLine('ABC', vbext_pk_Proc)总行数 = .ProcCountLines('ABC', vbext_pk_Proc).DeleteLines 开始行数, 总行数End WithEnd Sub'三导入、导出和替换一个模块或代码Sub 导出一个模块()ThisWorkbook.VBProject.VBComponents('A').Export 'D:/A.bas'Sub 导入一个模块()ThisWorkbook.VBProject.VBComponents.Import 'D:/A.bas' End SubSub 替换一个模块()'先删除模块,然后导入新模块ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents('A')ThisWorkbook.VBProject.VBComponents.Import 'D:/A.bas' End SubSub 替换A模块的B程序第一行代码()Dim 开始行数WithThisWorkbook.VBProject.VBComponents('B').CodeModule 开始行数 = .ProcBodyLine('ABC', vbext_pk_Proc).ReplaceLine 开始行数 + 1, 'MsgBox ''修改后'''End WithEnd Sub'四模块的查找'Find(查找内容,开始行数,开始列始,结束行数,结束列数,是否匹配) Sub 在B模块中查找()WithThisWorkbook.VBProject.VBComponents('B').CodeModule MsgBox .Find('我', 1, 1, 1, 1)End WithEnd SubSub 引用列表()Dim ref, iFor Each ref In ThisWorkbook.VBProject.Referencesi = i + 1Cells(i, 1) = Cells(i, 2) = ref.FullPathCells(i, 3) = ref.DescriptionNext refEnd SubSub 引用IDE()ThisWorkbook.VBProject.References.AddFromFile'D:\Program Files\VB98\VB6EXT.OLB'End SubSub 添加字典引用()ThisWorkbook.VBProject.References.AddFromFile'C:\Windows\System32\scrrun.dll'End SubSub 给文件添加模块()Dim wb As Workbook, ph As StringApplication.DisplayAlerts = Falseph = ThisWorkbook.Path & '\'Set wb = Workbooks.Open(ph & 'test.xls')ThisWorkbook.VBProject.VBComponents('A').Export ph & 'A.bas'Windows().Visible = Truewb.VBProject.VBComponents.Import ph & 'A.bas'wb.Close TrueSet wb = NothingKill ph & 'A.bas'Application.DisplayAlerts = TrueEnd SubSub 删除指定文件模块()Dim wb As Workbook, ph As StringApplication.DisplayAlerts = Falseph = ThisWorkbook.Path & '\'Set wb = Workbooks.Open(ph & 'test.xls') Windows().Visible = Truewb.VBProject.VBComponents.Remove wb.VBProject.VBComponents('A')wb.Close TrueSet wb = NothingApplication.DisplayAlerts = TrueEnd Sub。
VBA代码全集
目录一、引用 (2)二、Worksheet_Change事件： (2)三、相乘 (4)四、相减 (5)五、高级筛选 (5)六、双击事件 (7)七．单位汇总（sumif），单条件汇总 (9)八、多条件汇总（连接、sumif） (12)九、多条件汇总、ado (14)十、对账 (15)十一、sql筛选 (19)十二、sql连接、交叉汇总 (20)十三、select语句总结 (22)十四、报表（有层次） (23)一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。
二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2. Worksheet_Change事件代码：Private Sub Worksheet_Change(ByVal Target As Range)On error resume nextIf Target.Row > 3 And Target.Column = 2 Theni = Target.RowCells(i, 3) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets("简码表").Range("b4:c100"), 2, False)End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range)On Error Resume NextIf Target.Row > 3 And Target.Column = 5 Theni = Target.RowCells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 2, False)Cells(i, 7) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 3,False)Cells(i, 8) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 4, False)End IfEnd Sub三、相乘Sub 计算金额()Application.ScreenUpdating = FalseDim i As LongDim irow As Longirow = Range("a3").End(xldown).RowFor i = 4 To irowCells(i, 3) = Cells(i, 1) * Cells(i, 2)Next iApplication.ScreenUpdating = TrueEnd Sub四、相减Sub 相减()Application.ScreenUpdating = FalseRange("c3:c10000").ClearContentsDim i As LongDim irow As Longirow = Range("a5000").End(xlUp).RowFor i = 3 To irowCells(i, 3) = VBA.Round((Cells(i, 1) - Cells(i, 2)), 2)Next iApplication.ScreenUpdating = TrueEnd Sub五、高级筛选（工具-宏-录制新宏，宏名改成高级筛选）Sub 高级筛选()Sheets("业务").Range("A3:I10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=ActiveCell.Range("A1:B1"), Unique:=TrueEnd Sub六、双击事件1.插入-名称-定义（修改名称和引用位置）2．查看代码-插入-用户窗体工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource 为box1依次类推3. 业务表-查看代码 Worksheet beforedoubleclickPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 ThenUserForm1.ShowSheets("初始化").Range("m3") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowEnd IfEnd Sub备查代码：Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 ThenUserForm1.ShowSheets("初始化").Range("c2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowSheets("初始化").Range("f2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 8 ThenUserForm3.ShowEnd IfEnd Sub4．右键点击Userform1查看代码 Listbox1 dbclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox2.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox3.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox4.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox5.ListIndex, 0)Unload MeEnd Sub见上图5.插入用户窗体右键点击userform2 worksheet dblclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 7) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubUserform initializePrivate Sub UserForm_Initialize()Application.ScreenUpdating = FalseWith Sheets("初始化")Sheets("科目表").Range("h2:i10000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Range("m2:m3"), CopyToRange:=.Range("n2"), Unique:=TrueEnd WithApplication.ScreenUpdating = TrueEnd Sub七．单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇总!$A15,业务!I$4:I$10000)Sub 单位汇总1()Application.ScreenUpdating = Falserange("a1:i10000").ClearCells(3, 2) = "指标数"Cells(3, 3) = "拨款数"Cells(3, 4) = "余额"Cells(1, 7) = "单位"Cells(3, 7) = "单位"Cells(3, 8) = "指标数"Cells(3, 9) = "拨款数"Sheets("业务").Range("D3:D10000").AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range("A3"), Unique:=TrueSheets("业务").Range("A3:J10000").AdvancedFilter Action:=xlFilterCopy, _CriteriaRange:=Range("G1:G2"), CopyToRange:=Range("G3:I3"), Unique:=FalseDim i As LongDim irow As Longirow = Range("a3").End(xlDown).RowFor i = 4 To irowCells(i, 2) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("h4:h10000"))Cells(i, 3) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("i4:i10000"))Cells(i, 4) = VBA.Round(Cells(i, 2) - Cells(i, 3), 2)Next iRange("g1:i10000").ClearApplication.ScreenUpdating = TrueEnd Sub八、多条件汇总（连接、sumif）连接=k4&l4&m4&n4Vba：Sub 多条件汇总()Application.ScreenUpdating = FalseRange("a1:p10000").ClearSheets("业务").Range("D3:G10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("B3:E3"), Unique:=TrueSheets("业务").Range("D3:I10000").AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range("K3:P3"), Unique:=FalseDim j As LongDim jrow As Longjrow = Range("k3").End(xlDown).RowFor j = 4 To jrowCells(j, 10) = Cells(j, 11) & Cells(j, 12) & Cells(j, 13) & Cells(j, 14)Next jDim i As LongDim irow As Longirow = Range("b3").End(xlDown).RowFor i = 4 To irowCells(3, 6) = "指标数"Cells(3, 7) = "拨款数"Cells(3, 8) = "余额"Cells(i, 1) = Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5)Cells(i, 6) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("o4:o10000"))Cells(i, 7) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("p4:p10000"))Cells(i, 8) = VBA.Round(Cells(i, 6) - Cells(i, 7), 2)Next iRange("i3:p10000").ClearRange("a1:a10000").DeleteApplication.ScreenUpdating = TrueEnd Sub九、多条件汇总、adoSub 多条件汇总()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标,sum(拨款数) as 预算股拨款 from[业务$a3:J10000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("多条件汇总").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("多条件汇总").Range("a4").CopyFromRecordset rst rst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十、对账Sub 预算股()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标 from[预算股$a3:m50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("对帐").Cells(3, i + 10) = rst1.Fields(i - 1).NameNext iSheets("对帐").Range("k4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = " SELECT 单位,类,款,项, sum(指标数) as 专业股指标 from[专业股$a3:j50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("对帐").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("对帐").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = Nothings = Application.WorksheetFunction.CountA(Range("k4:k10000")) + 4Range("T4:W10000").SelectSelection.CopyRange("K" & s).SelectActiveSheet.PasteRange("X4:X10000").SelectSelection.CopyRange("P" & s).SelectActiveSheet.PasteRange("X3").SelectSelection.CopyRange("P3").SelectActiveSheet.PasteDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(预算股指标) as 预算股指标 ,sum(专业股指标) as 专业股指标 from[对帐$k3:p50000] GROUP BY 单位,类,款,项"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("对帐").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("对帐").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十一、sql筛选Sub 筛选()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT distinct 单位,类,款,项 from[专业$a3:h10000]"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("筛选").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("筛选").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = True End Sub十二、sql连接、交叉汇总Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 股,月,归口,单位,类,款,项,指标数 from [专业$a3:h10000] union ALL SELECT 股,月,归口,单位,类,款,项,指标数 from [预算$a3:l10000] order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(1, i + 19) = rst.Fields(i - 1).NameNext iSheets("连接").Range("t2").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 汇总()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " transform sum(指标数) SELECT 单位,类,款,项 from [连接$t1:aa10000] where 归口= '" & Range("h2").Value & "' and 月=" & Range("i2").Value & " group by 单位,类,款,项 pivot 股" rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("连接").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingRange("t1:aa10000").ClearContentsApplication.ScreenUpdating = TrueEnd Sub十三、select语句总结1、筛选（false ---筛选全部）Select 列表名称1,列表名称2,…….列表名称n from [表$区域]或者Select * from [表$区域]2、筛选唯一的数据Select distinct 列表名称1,列表名称2,…….列表名称n from [表$区域]3、分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Group by列表名称1,列表名称2,…….列表名称n4、条件分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Where 归口=’”& range(“”).value &”’ and 月=”& range(“”).value &” Group by列表名称1,列表名称2,…….列表名称n5、交叉汇总Transform sum() select 列名称1,……列名称n from[表$区域] group by 列名称1，…..列名称n pivot 交叉事项6、连接Select 列名称1，…列名称n from[表$区域] union all Select 列名称1，…列名称n from[表$区域] order by 列名称 desc十四、报表（有层次）连接Transform sum（指标数），pivot 股按单位、类、款进行汇总按单位、类进行汇总按单位进行汇总连接以上四个表的内容，并按单位、类、款、项进行排序，其中单位按降序排序1、整体写代码Sub 报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 股,月,归口,单位,类,款,项 union all SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 股,月,归口,单位,类,款,项 order by 股 desc"rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("报表").Cells(3, i + 9) = rst1.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = "transform sum(指标数) SELECT 单位,类,款,项 from[报表$j3:q10000] where 归口='" & Range("g2") _.Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 order by 单位 desc pivot 股 "rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("报表").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = NothingDim strsql3 As StringDim cnn3 As New ADODB.ConnectionDim rst3 As New ADODB.Recordsetcnn3.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql3 = "SELECT 单位,类,款,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位,类,款 order by 单位 desc"rst3.Open strsql3, cnn3For i = 1 To rst3.Fields.CountSheets("报表").Cells(3, i + 26) = rst3.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rst3rst3.Closecnn3.CloseSet rst3 = NothingSet cnn3 = NothingDim strsql4 As StringDim cnn4 As New ADODB.ConnectionDim rst4 As New ADODB.Recordsetcnn4.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql4 = "SELECT 单位,类,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位,类 order by 单位 desc"rst4.Open strsql4, cnn4For i = 1 To rst4.Fields.CountSheets("报表").Cells(3, i + 32) = rst4.Fields(i - 1).NameNext iSheets("报表").Range("ag4").CopyFromRecordset rst4rst4.Closecnn4.CloseSet rst4 = NothingSet cnn4 = NothingDim strsql5 As StringDim cnn5 As New ADODB.ConnectionDim rst5 As New ADODB.Recordsetcnn5.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql5 = "SELECT 单位,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位 order by 单位 desc"rst5.Open strsql5, cnn5For i = 1 To rst5.Fields.CountSheets("报表").Cells(3, i + 37) = rst5.Fields(i - 1).NameNext iSheets("报表").Range("al4").CopyFromRecordset rst5rst5.Closecnn5.CloseSet rst5 = NothingSet cnn5 = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightRange("ad3") = "项"Columns("Aj:Ak").SelectSelection.Insert Shift:=xlToRightRange("aj3") = "款"Range("ak3") = "项"Columns("Ap:Ar").SelectSelection.Insert Shift:=xlToRightRange("ap3") = "类"Range("aq3") = "款"Range("ar3") = "项"Dim strsql6 As StringDim cnn6 As New ADODB.ConnectionDim rst6 As New ADODB.Recordsetcnn6.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql6 = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ao3:at10000] order by 单位 desc,类,款,项 "rst6.Open strsql6, cnn6For i = 1 To rst6.Fields.CountSheets("报表").Cells(3, i) = rst6.Fields(i - 1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rst6rst6.Closecnn6.CloseSet rst6 = NothingSet cnn6 = NothingRange("j1:au10000").ClearContentsDim p As LongDim prow As Longprow = Range("a3").End(xlDown).RowFor p = 4 To prowRange("g3") = "金额"Cells(p, 7) = VBA.Round(Cells(p, 6) - Cells(p, 5), 2)Next pApplication.ScreenUpdating = TrueEnd Sub2、分开写代码：Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 月,归口,股,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 月,归口,股,单位,类,款,项 union all SELECT 月, 归口,股,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 月, 归口,股,单位,类,款,项 order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 9) = rst.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 项()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';DataSource=" & ThisWorkbook.FullNamestrsql = "transform sum(指标数) SELECT 单位,类,款,项 from [报表$j3:q10000] where 归口= '" & Range("g2").Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 pivot 股"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 19) = rst.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 款()Application.ScreenUpdating = FalseCall 项Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$t3:y10000] group by 单位,类,款 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 26) = rst.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightCells(3, 30) = "项"Application.ScreenUpdating = TrueEnd SubSub 类()Application.ScreenUpdating = FalseCall 款Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$aa3:af10000] group by 单位,类 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 33) = rst.Fields(i - 1).NameNext iSheets("报表").Range("ah4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AJ:AJ").SelectSelection.Insert Shift:=xlToRightColumns("AK:AK").SelectSelection.Insert Shift:=xlToRightRange("AJ3").SelectActiveCell.FormulaR1C1 = "款"Range("AK3").SelectActiveCell.FormulaR1C1 = "项"Application.ScreenUpdating = TrueEnd SubSub 单位()Application.ScreenUpdating = FalseCall 类Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$ah3:am10000] group by 单位 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 40) = rst.Fields(i - 1).NameNext iSheets("报表").Range("ao4").CopyFromRecordset rstrst.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = True Columns("AP:AP").SelectSelection.Insert Shift:=xlToRight Columns("AQ:AQ").SelectSelection.Insert Shift:=xlToRight Columns("AR:AR").SelectSelection.Insert Shift:=xlToRight Range("AP3").SelectActiveCell.FormulaR1C1 = "类"Range("AQ3").SelectActiveCell.FormulaR1C1 = "款"Range("AR3").SelectActiveCell.FormulaR1C1 = "项" End SubSub 报表()If Range("i2") = "类" ThenCall 类ElseIf Range("i2") = "款" ThenCall 款ElseCall 项End IfEnd SubSub 总报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ao3:at10000] order by 单位 desc,类,款,项 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingRange("j1:br10000").ClearApplication.ScreenUpdating = TrueEnd Sub。
VBA中的常用函数和方法解析
VBA中的常用函数和方法解析VBA（Visual Basic for Applications）是一种用于Microsoft Office应用程序的编程语言，它可以让用户根据自己的需求自动化执行各种重复性的任务。
在VBA中，函数和方法是常用的工具，它们可以帮助用户处理和操作数据，提高工作效率。
本文将详细解析VBA中常用的函数和方法，以帮助读者更好地理解和应用。
一、函数的介绍和使用1.1 VBA函数的概念函数是一段代码，可以接受输入参数，并根据函数的定义执行一系列操作，最后返回一个值。
在VBA中，函数可以用于进行数学运算、字符串处理、日期和时间处理等等。
1.2 常用的VBA函数1.2.1 数学函数VBA提供了丰富的数学函数，可以用于计算数值、取整、取绝对值等等。
例如：- Abs函数：用于返回一个数的绝对值。
- Sqrt函数：用于返回一个数的平方根。
- Round函数：用于对一个数进行四舍五入。
- Int函数：用于返回一个数的整数部分。
- Max函数和Min函数：用于返回一组数中的最大值和最小值。
1.2.2 字符串函数VBA中的字符串函数可以用于处理和操作文本数据。
例如：- Len函数：用于返回一个字符串的长度。
- UCase函数和LCase函数：用于将字符串转换为大写或小写。
- Left函数和Right函数：用于提取一个字符串的左侧或右侧的指定字符数。
- Mid函数：用于提取一个字符串的指定位置上的字符。
- Replace函数：用于将指定的字符替换为另一个字符。
1.2.3 日期和时间函数VBA中的日期和时间函数可以用于处理和计算日期、时间和时间间隔。
例如：- Now函数：返回当前的日期和时间。
- Date函数：返回当前的日期。
- Time函数：返回当前的时间。
- DateSerial函数：根据给定的年、月和日返回日期。
- TimeSerial函数：根据给定的小时、分钟和秒返回时间。
1.3 函数的使用方法使用VBA函数的方法很简单，只需在代码中使用函数名加上圆括号，并在括号中传入参数。
VBA常用代码解析(第十三讲)
VBA常用代码解析（第十三讲）055 在工作表中添加艺术字在工作表中插入艺术字，可以使用AddTextEffect方法，如下面的代码所示。
Sub TextEffect() DimmyShape As Shape On ErrorResume Next Sheet1.Shapes('myShape').Delete SetmyShape =Sheet1.Shapes.AddTextEffect _(PresetTextEffect:=msoTextEffect15，_ Text:='我爱Excel Home'，FontName:='宋体'，FontSize:=36，_FontBold:=msoFalse，FontItalic:=msoFalse，_ Left:=100，Top:=100) WithmyShape .Name = 'myShape'With .Fill .Solid .ForeColor.SchemeColor = 55 .Transparency = 0 End With With .Line .Weight = 1.5 .DashStyle = msoLineSolid .Style = msoLineSingle .Transparency =0 .ForeColor.SchemeColor = 12 .BackColor.RGB = RGB(255，255，255) End With EndWith SetmyShape = Nothing End Sub 代码解析：TextEffect过程在工作表中插入艺术字并设置其格式。
第3、4行代码删除工作表中可能存在的艺术字，以免重复添加。
第5行到第9行代码使用AddTextEffect方法在工作表中插入艺术字，AddTextEffect方法创建艺术字对象。
返回一个Shape对象，该对象代表新建的艺术字对象，语法如下：expression.AddTextEffect(PresetTextEffect，Text，FontName，FontSize，FontBold，FontItalic，Left，Top)参数expression是必需的，返回一个Shapes对象。
VBA常用注释代码
VBA常用注释代码Sub 开启最近使用过的档案()MsgBox "显示最近使用过的第二个文件名称，并开启它"MsgBox Application.RecentFiles(2).NameApplication.RecentFiles(2).OpenEnd SubSub 内存容量()MsgBox "Excel可使用的内存大小为：" & Application.MemoryTotal MsgBox "Excel已使用的内存为：" & Application.MemoryUsedMsgBox "Excel剩余的内存大小为：" & Application.MemoryFree End SubSub 全屏幕模式()Dim gamen As BooleanMsgBox "将Excel的显示模式设为全屏幕"gamen = Application.DisplayFullScreenApplication.DisplayFullScreen = TrueMsgBox "回复原来的状态"Application.DisplayFullScreen = gamenEnd SubfileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")希望能将一个TXT文件自动分割到几个SHEET里面，如果它超过65536行Dim ResultStr As StringDim FileName As StringDim FileNum As IntegerDim Counter As DoubleFileName = Application.GetOpenFilenameIf FileName = "" Then EndFileNum = FreeFile()Open FileName For Input As #FileNumApplication.ScreenUpdating = FalseWorkbooks.Add Template:=xlWorksheetCounter = 1Do While Seek(FileNum) <= LOF(FileNum)Application.StatusBar = "Importing Row " & _Counter & " of text file " & FileNameLine Input #FileNum, ResultStrIf Left(ResultStr, 1) = "=" ThenActiveCell.Value = "'" & ResultStrElseActiveCell.Value = ResultStrEnd IfIf ActiveCell.Row = 65536 ThenActiveWorkbook.Sheets.AddElseActiveCell.Offset(1, 0).SelectEnd IfCounter = Counter + 1LoopCloseApplication.StatusBar = False如何用vba代码显示当前工作簿是只读状态还是可修改状态：MsgBox ThisWorkbook.ReadOnly欲判断单元格中是否是#N/A如何处理.如:If Range("F" & bl & "").Value = "#N/A" Then这样该单元格内容类型是否为字符串.不加引号报错.:Sub bb()Set testrng = [b1]If IsError(testrng) ThenIf testrng = CVErr(xlErrNA) ThenMsgBox "就是#N/A"ElseMsgBox "其他错误"End IfElseMsgBox "没有错误"End IfEnd SubSub UseFileDialogOpen()Dim lngCount As Long' Open the file dialogWith Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True.Show' Display paths of each file selectedFor lngCount = 1 To .SelectedItems.CountMsgBox .SelectedItems(lngCount)Next lngCountEnd WithEnd Sub从另外一个未打开的Excel文件中读取数据的函数下面这个函数调用XLM宏从未打开的工作簿中读取数据. 注意: 该函数不能用于公式.GetValue函数,需要以下四个变量path: 未打开的Excel文件的路径(e.g., "d:¥test") file: 文件名(e.g., "test.xls")sheet: 工作表的名称(e.g., "Sheet1")ref: 引用的单元格(e.g., "C4")Private Function GetValue(path, file, sheet, ref)' 从未打开的Excel文件中检索数据Dim arg As String' 确保该文件存在If Right(path, 1) <> "¥" Then path = path & "¥"If Dir(path & file) = "" ThenGetValue = "File Not Found"Exit FunctionEnd If' 创建变量arg = "'" & path & "[" & file & "]" & sheet & "'!" & _Range(ref).Range("A1").Address(, , xlR1C1)' 执行XLM 宏GetValue = ExecuteExcel4Macro(arg)End Function使用该函数:将该语句复制到VBA的模块中,然后,在适当的语句中调用该函数. 下面的例子显示D:¥test 下的文件test.xls 的Sheet1中的单元格”A1”的内容.Sub TestGetValue()p = "d:¥test"f = "test.xls"s = "Sheet1"a = "A1"MsgBox GetValue(p, f, s, a)End Sub下面还有一个例子.这个语句从一个未打开的文件中读取1200个数值(100行12列),并将结果填到当前工作表中.Sub TestGetValue2()p = "d:¥test "f = "test.xls"s = "Sheet1"Application.ScreenUpdating = FalseFor r = 1 To 100For c = 1 To 12a = Cells(r, c).AddressCells(r, c) = GetValue(p, f, s, a)Next cNext rApplication.ScreenUpdating = TrueEnd Sub说明: 如果工作簿处于隐藏状态,或者工作表是图表工作表,将会报错.在VBA中怎么象"我的电脑中的文件夹档"一样让用户自已选择路径和文件.选择文件：Application.GetopenFilename选择文件夹：1、Application.FileDialog(msoFileDialogFolderPicker)在H 列，从H3 开始，每隔3行分别输入 A 到H ！Application.ScreenUpdating = FalseDim arr(1 To 65536, 1 To 1), i As LongFor i = 3 To 65536 Step 4arr(i, 1) = Chr(((i - 3) ¥ 4) Mod 8 + 65)NextRange("h1:h65536") = arrApplication.ScreenUpdating = True有一單元格，我設置了格式為自動換行。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
VBA常用代码解析（第十三讲）055 在工作表中添加艺术字在工作表中插入艺术字，可以使用AddTextEffect方法，如下面的代码所示。
Sub TextEffect() DimmyShape As Shape On ErrorResume Next Sheet1.Shapes('myShape').Delete SetmyShape =Sheet1.Shapes.AddTextEffect _(PresetTextEffect:=msoTextEffect15，_ Text:='我爱Excel Home'，FontName:='宋体'，FontSize:=36，_FontBold:=msoFalse，FontItalic:=msoFalse，_ Left:=100，Top:=100) WithmyShape .Name = 'myShape'With .Fill .Solid .ForeColor.SchemeColor = 55 .Transparency = 0 End With With .Line .Weight = 1.5 .DashStyle = msoLineSolid .Style = msoLineSingle .Transparency =0 .ForeColor.SchemeColor = 12 .BackColor.RGB = RGB(255，255，255) End With EndWith SetmyShape = Nothing End Sub 代码解析：TextEffect过程在工作表中插入艺术字并设置其格式。
第3、4行代码删除工作表中可能存在的艺术字，以免重复添加。
第5行到第9行代码使用AddTextEffect方法在工作表中插入艺术字，AddTextEffect方法创建艺术字对象。
返回一个Shape对象，该对象代表新建的艺术字对象，语法如下：expression.AddTextEffect(PresetTextEffect，Text，FontName，FontSize，FontBold，FontItalic，Left，Top)参数expression是必需的，返回一个Shapes对象。
参数PresetTextEffect是必需的，艺术字预置文本效果，可为MsoPresetTextEffect 常量之一，等同于在工作表中插入艺术字时的样式选项卡。
参数Text是必需的，艺术字对象中的文字。
参数FontName是必需的，艺术字对象中所用的字体名称。
参数FontSize是必需的，以磅为单位给出艺术字对象中所用的字体大小。
参数FontBold是必需的，在艺术字中要加粗的字体。
参数FontItalic是必需的，在艺术字中要倾斜的字体。
参数Left和参数Top是必需的，相对于文档的左上角、顶部，以磅为单位给出艺术字对象边框左上角的位置。
第11行代码将艺术字对象重命名为“myShape”。
第12行到第16行代码设置艺术字对象的填充格式。
其中第13行代码将填充格式设置为均一的颜色，应用于FillFormat 对象的Solid 方法将指定的填充格式设置为均一的颜色，可用本方法将带有渐进色、纹理、图案或背景的填充格式转换为单色的填充格式。
第14行代码设置填充的颜色。
第15行代码设置填充的透明度。
第17行到第24行代码设置艺术字对象的线条格式属性。
其中第18行代码设置线条粗细，第19行代码设置线条虚线样式，第20行代码设置线条区域的样式，第21行代码设置线条的透明度，第22行代码设置前景色，第23行代码设置填充背景的颜色。
▲056 遍历工作表中的图形工作表中的多个图形，如果使用系统缺省名称，如“文本框1”、“文本框2”这样前面是固定的字符串，后面是序号的，可以使用For...Next 语句遍历图形，如下面的代码所示。
Sub ErgShapes_1() Dimi As Integer Fori = 1 To 4 Sheet1.Shapes('文本框' & i).TextFrame.Characters.Text = ““Next End Sub代码解析：ErgShapes_1过程清除工作表中四个图形文本框中的文字。
第3行到第5行代码，使用Shapes属性在工作表上的三个图形文本框中循环。
Shapes属性返回Shapes对象，代表工作表或图形工作表上的所有图形，可以使用Shapes(index)返回单个的Shape对象，其中index是图形的名称或索引号。
返回单个的Shape对象后使用TextFrame属性和Characters方法清除文本框中的字符，关于Shape对象的TextFrame 属性和Characters方法请参阅▲53 。
如果图形的名称没有规律，可以使用For Each...Next 语句循环遍历所有图形，根据Type属性返回的图形类型进行相应的操作，如下面的代码所示。
Sub ErgShapes_2() DimmyShape As Shape Dimi As Integer i =1 ForEach myShape In Sheet1.Shapes If myShape.Type = msoTextBox ThenmyShape.TextFrame.Characters.Text ='这是第' & i & '个文本框' i = i + 1 End If Next End Sub代码解析：ErgShapes_2过程在工作表中的所有图形文本框中写入文本。
第5行代码使用For Each...Next语句循环遍历工作表中所有的图形对象。
第6行到第9行代码如果图形对象是文本框则在文本框中写入文本。
其中第6行代码根据Type属性判断图形对象是否为文本框，应用于Shape对象的Type属性返回或设置图形类型，MsoShapeType类型，如表格所示。
▲057 移动、旋转图片工作表中的图片可以移动、旋转，如下面的代码所示。
Sub MoveShape() Dimi As Long Dimj As LongWithSheet1.Shapes(1) For i = 1 To 3000 Step 5 .Top = Sin(i * (3.1416 / 180)) * 100+ 100 .Left = Cos(i * (3.1416 / 180)) *100+ 100 .Fill.ForeColor.RGB = i * 100 For j = 1 To10 .IncrementRotation -2 DoEvents Next Next EndWith End Sub代码解析：MoveShape过程移动、旋转工作表中的图片并不断改变其填充的前景色。
第6行代码设置图片的Top属性值，应用于Shape对象的Top属性设置图形的顶端到工作表顶端的距离。
在循环的过程中使用Sin函数将Top属性值设置为一个圆形的弧度值。
Sin函数返回指定参数的正弦值，语法如下：Sin(number)参数number表示一个以弧度为单位的角。
Sin函数取一角度为参数值，并返回角的对边长度除以斜边长度的比值，将角度除以180后即能角度转换为弧度。
第7行代码设置图片的Left属性值，应用于Shape对象的Left属性设置图形从左边界至A 列左边界(在工作表中)或图表区左边界(在图表工作表中)的距离。
在循环的过程中使用Cos函数将Left属性值设置为一个圆形的弧度值。
Cos函数返回指定一个角的余弦值，语法如下：Cos(number)参数number表示一个以弧度为单位的角。
Cos函数的number参数为一个角，并返回直角三角形两边的比值，该比值为角的邻边长度除以斜边长度之商，将角度除以180后即能角度转换为弧度。
第8行代码设置图片填充的前景色随着循环的过程不断的变化。
使用Fill属性返回一个FillFormat对象，FillFormat对象代表图形的填充格式，其ForeColor 属性设置对象填充的前景色。
第9行到第11行代码在图形移动的过程中使用IncrementRotation方法设置图形绕z 轴的转角，IncrementRotation方法以指定的度数为增量，更改指定的图形绕z 轴的转角，语法如下：expression.IncrementRotation(Increment)参数expression是必需的，返回一个Shape对象。
参数Increment是必需的，以度为单位指定图形在水平方向的旋转量，正值使图形按顺时针方向旋转，负值使图形按逆时针方向旋转。
其中第11行是关键的代码，使用DoEvents函数转让控制权，否则达不到预计的视觉效果。
运行MoveShape过程，工作表的图形在自身进行逆时针方向旋转的同时沿着一个圆形的弧度进行移动，并不断改变其填充的颜色。
▲058 工作表中自动插入图片在日常工作中经常需要在工作表中插入大量图片，比如在工作表中需要根据A列的名称在C列插入保存在同一目录中的相应的图片，如果使用手工插入不仅非常繁琐且极易出错，而使用VBA代码可以很好的完成操作。
示例代码如下：Sub insertPic() Dimi As Integer DimFilPath As String Dimrng As Range Dims As String WithSheet1 For i = 3To .Range('a65536').End(xlUp).Row FilPath = ThisWorkbook.Path &'\' & .Cells(i，1).Text & '.jpg' IfDir(FilPath) ““Then .Pictures.Insert(FilPath).Select Set rng = .Cells(i，3) With Selection .Top = rng.Top + 1 .Left = rng.Left + 1 .Width = rng.Width - 1 .Height = rng.Height - 1 End With Else s = s & Chr(10) & .Cells(i，1).Text End If Next .Cells(3，1).Select EndWith If s ““Then MsgBox s & Chr(10) & '没有照片!' EndIf End Sub代码解析：insertPic过程使用Insert方法在工作表中插入图片。