VBA教程
excel利用VBA批量生成几十张销售通知单
每天都会收到同事提报的销售清单数据，每天的表里都有几十张SHEET，她需要每天将这几十张SHEET中的部分数据粘贴成一张日清单总表。她日复一日的重复着这些工作，如此无意义的体力劳动，让她深感疲倦。于是她问我有没有什么办法可以快速将这些分表数据弄到总表中去。也就是说她要将下图 【图1】中的数据自动粘贴到总表中去，即【图2】的效果。 【图1】源表如下：↓
特殊隐藏名称(Name) 在 Excel 中的使用基础教程
我们有一篇文章讲了Excel 名称(Name)及其 VBA 中的使用, 其实在 Excel 中还有一个更为神奇的名称空间，这个被隐藏的名称空间存在于 Excel 应用程序当前实例的一块内存区域中，动态链接库加载项(即 Xll)能够在这块区域中存储临时的名称。通过这个区域，Xll 加载项甚至可以在没有可用宏表的情况下来定义名称。要操作这个隐藏名称我们需要用到宏表函数中的 SET.NAME、GET.NAME 和 EVALUATE 这三个函数。当 SET.NAME 被应用于宏表中时，创建的名称是工作表级别的(局部名称)，而在 Xll 中使用 SET.NAME 所定义的名称是应用程序级别的(注意：不只是工作簿级别的，而是可用于所有工作簿的超全局名称)并且储存在一个隐藏的区域中。正式以上原因使得定义在被隐藏区域的名称有一些特殊的功能，这使得它们与标准工作簿名称有很大的不同。这些功能我们将在后面进行说明。一、与隐藏着的名称相关的可用 C API 命令如下：Excel4(xlfSetName,&xResult,2,&xName,&xValue): 定义包含xValue的名称xlName。 Excel4(xlfGetName,&xResult,1,&xName): 获取xlName的定义(例如”=1”)并将它存储在xResult中。 Excel4(xlfEvaluate,&xResult,1,&xName): 获取xlName的内容(例如：1)并将它存储在xResult中。 Excel4(xlfSetName,&xResult,1,&xName): 删除xName(忽略第二个参数)。二、在VBA中访问被隐藏的名称空间 1、创建一个隐藏的名称下面的语句创建一个包含字符串“OK”的名为Test的隐藏名称： Application.ExecuteExcel4Macro "SET.NAME(""Test"",""OK"")"2、获取一个隐藏名称所代表的内容为了获取名称Test所代表的内容，使用下面的代码： TestVal = Application.ExecuteExcel4Macro("Test")注意，只使用名称本身作为ExecuteExcel4Macro的参数。
excel API Hook 的应用 绕过 VBA 密码保护
这是一段从网络收集的代码, 代码运用 API Hook 来绕过 VBA 的密码保护机制，在 VBE 中可以直接查看加密的 VBA 工程而不需要密码验证。网络转载，非原创，感谢作者提供的强大代码。注意：本代码不能用于 64 位 Office, 有时间我会把它修改一下，使其可以用于 64 位 Office。'*************************************************************************** '* '* MODULE NAME: Protected VBA project Picklock(PVP) '* '* Usage: 运行FrmHookMain窗口,点补丁,然后双击工程窗口中有密码保护的模块 '* 应该能够直接打开了:) '* '* '* DESCRIPTION: 在写中文字符串转换为拼音函数(HzToPy)过程中,第一次发现VBA功能的强大. '* 于是这次尝试将其他语言中比较好写的API HOOK移植成VBA代码, '* 正好顺便把VBA密码保护去掉,喜欢加密码的朋友不要生气啊:) '* 总的来说VBA的写法和其他语言区别不大,但VBA毕竟不太方便,代码必须放在标准模块中. '* 再有就是对指针的支持实在有限,于是最后选择了一种写起来最简单的API hook方法, '* 就是所谓的陷阱法.如果你不太清楚什么是API HOOK,请求助于google. '* '* Theory： 这里就不说API hook的方法了,都是传统方法没什么可说的,这里只 '* 简单说下VBA模块密码破解.其实这些我也不是很了解,毕竟知道加密过程 '* 用处不大,这个问题上我比较关心结果:) '* 判断有密码以及提示输入密码都是VBE6.dll干得好事.如果有密码, '* VBE6.dll会调用DialogBoxParamA显示VB6INTL.dll资源中的第4070号 '* 对话框(就是那个输入密码的窗口),若DialogBoxParamA返回值非0, '* 则VBE会认为密码正确,然后乖乖展开加密模块的资源.很显然其中存在很大 '* 漏洞,就像给日记本加上了锁,但里面全是活页,我们不需要打开锁,只要从侧面 '* 取出活页就可以了.这个从侧面取活页的过程就是hook住DialogBoxParamA函数, '* 若程序调用DialogBoxParamA装入4070号对话框,我们就直接返回1,让 '* VBE以为密码正确. '* '* PS: PVP是在一个叫Advanced VBA Password Recovery (AVPR)的软件启发下 '* 作出来的,AVPR提供了一个VBA Backdoor功能就是跳过密码直接查看工程资源. '* 它的原理和PVP一样,但用了通用性比较差的方法,适用系统比较有限,而PVP的方法 '* 理论上适用于所有采用第4070号对话框录入密码的Office系统. '* 经测试PVP适用于Office 2002, 2003, 2007,其他版本尚未测试,但估计依然有效. '* 在2000和XP系统上测试通过,但条件限制没有在Vista系统上测试,听说Vista有些机制 '* 可能影响API hook,暂时没机会测试就先这样吧~ '* '* *64位操作系统下面的API hook代码肯定运行出错,就不要测试了 '* '*************************************************************************** Option Explicit Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Long, Source As Long, ByVal Length As Long) Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _ ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _ ByVal lpProcName As String) As Long Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" _ (ByVal hInstance As Long, ByVal pTemplateName As Long, ByVal hWndParent As Long, _ ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer Dim HookBytes(0 To 5) As Byte Dim OriginBytes(0 To 5) As Byte Dim pFunc As Long Dim Flag As Boolean Private Function GetPtr(ByVal Value As Long) As Long '获得函数的地址 GetPtr = Value End Function Public Sub RecoverBytes() '若已经hook,则恢复原API开头的6字节,也就是恢复原来函数的功能 If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6 End Sub Public Function Hook() As Boolean Dim TmpBytes(0 To 5) As Byte Dim p As Long Dim OriginProtect As Long Hook = False 'VBE6.dll 调用 DialogBoxParamA 显示 VB6INTL.dll 资源中的第 4070 号对话框(就是输入密码的窗口) '若 DialogBoxParamA 返回值非 0,则 VBE 会认为密码正确,所以我们要 hook DialogBoxParamA 函数 pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA") '标准 api hook 过程之一: 修改内存属性,使其可写 If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) <> 0 Then '标准api hook过程之二: 判断是否已经hook,看看API的第一个字节是否为&H68, '若是则说明已经Hook MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6 If TmpBytes(0) <> &H68 Then '标准 api hook 过程之三: 保存原函数开头字节,这里是6个字节,以备后面恢复 MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6 '用 AddressOf 获取 MyDialogBoxParam 的地址 '因为语法不允许写成p = AddressOf MyDialogBoxParam,这里我们写一个函数 'GetPtr,作用仅仅是返回 AddressOf MyDialogBoxParam 的值,从而实现将 'MyDialogBoxParam 的地址付给p的目的 p = GetPtr(AddressOf MyDialogBoxParam) '标准api hook过程之四: 组装API入口的新代码 'HookBytes 组成如下汇编 'push MyDialogBoxParam的地址 'ret '作用是跳转到MyDialogBoxParam函数 HookBytes(0) = &H68 MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4 HookBytes(5) = &HC3 '标准api hook过程之五: 用HookBytes的内容改写API前6个字节 MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6 '设置hook成功标志 Flag = True Hook = True End If End If End Function Private Function MyDialogBoxParam(ByVal hInstance As Long, _ ByVal pTemplateName As Long, _ ByVal hWndParent As Long, _ ByVal lpDialogFunc As Long, _ ByVal dwInitParam As Long) As Integer If pTemplateName = 4070 Then '有程序调用DialogBoxParamA装入4070号对话框,这里我们直接返回1,让 'VBE以为密码正确了 MyDialogBoxParam = 1 Else '有程序调用DialogBoxParamA,但装入的不是4070号对话框,这里我们调用 'RecoverBytes函数恢复原来函数的功能,在进行原来的函数 RecoverBytes MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _ hWndParent, lpDialogFunc, dwInitParam) '原来的函数执行完毕,再次hook Hook End If End Function
Excel VBA 程序之错误处理 基础教程
关于程序错误处理，是一个常见而又非常被容易忽视的问题。错误处理，顾名思义就是程序在发生错误时的处理过程。为什么要有错误处理？如果没有错误处理又会怎么样呢？我们首先来简单的说说上面两个问题。一、为什么要有错误处理呢？这是因为任何一个程序都不可能说是不会发生任何错误的(注意：我们这里说的错误只是指的狭义的逻辑错，并不包括语法错)。二、如果没有错误处理会发生什么呢？我们先来看一段简单的代码：SubTest()DimMAsLongDimNAsLongM=Val(InputBox("请输入一个整数"，"M*N"))N=Val(InputBox("请输入一个整数"，"M*N"))MsgBoxCStr(M)&"×"&CStr(N)&"="&CStr(M*N)
excel COM 加载项编写过程
遇到几个朋友问COM加载项怎么做，搜索一下论坛似乎没有这方面详细的做法。所以根据我摸索出来的道路，写这篇东西糊弄糊弄大众，赚赚黑心水晶。嘿嘿。。。条条大道通罗马，这篇东东不是绝对正确也不是唯一一条道路。修仙也好，修魔也好，方向不同，但最终都是与天争命都是追求天道的真理（网络小说看多了）。欲练神功，请先自宫。。。 由于贫道作文能力有限，写出来的东西逻辑不清晰，觉得烦的朋友直接研究代码去吧。 废话不说了，转入正题： 一、创建工程并设置属性 二、连接Excel 三、响应Excel事件 四、调试编译分发安装 我们编写COM加载项就是要在Excel里面做点什么，如果用一个变量来保存Excel对象的话，我们基本上就能任意把Excel捏圆捏扁。变量的作用域是作为模块级的还是全局的就看你的实际情况，为了方便，这里定义为全局变量。添加一个模块“mduMain”，在模块中定义变量：Public gExcelApp As Excel.Application Public gExcelApp As Excel.Application即出现Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant) End Sub Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant) End Sub 在该过程中写入“Set gExcelApp = Application”
ADO 访问 Excel 数据 实现代码及源码下载
我们都知道可以像操作数据表一样使用 ADO 来访问 Excel 文档, 在 Excel 2003 及以前的版本是使用的Microsoft.Jet.OLEDB.4.0 引擎(简称 Jet 引擎)来访问 Excel 数据，但随着 Offic 2007 的推出， 微软发布了最新的 Microsoft.ACE.OLEDB.12.0 引擎(简称 ACE 引擎). 这个新的数据引擎不仅可以访问 Excel 2007 文件类型， 还兼容支持 Excel 97-2003 文件类型，下面就来简单来说一说这两个引擎。不同的 ADO 引擎访问 Excel 数据有不同的连接字符串的写法，Excel 2003 版本和 2007 版本的写法分别如下(其中的 [Excel-FullName] 为你需要访问的 Excel 文件全名):Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & [Excel-FullName] & _ "; Extended Properties='Excel 8.0; HDR=Yes; IMEX=1'" Excel2007 及以后版本的写法: "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & [Excel-FullName] & _ "; Extended Properties='Excel 12.0; HDR=YES; IMEX=1'" 特别说明: HDR=YES 表示第一行是列名而不是数据； HDR=NO 则正好与前面的相反, 系统默认为 HDR=YES。 IMEX ( IMport EXport mode )有三种模式： 0 表示输出模式: 此时 Excel 文档只能用来做“写入”用途。 1 表示输入模式: 此时 Excel 文档只能用来做“读取”用途。 2 表示链接模式(完全更新能力): 此时 Excel 文档可同时支持“读取”与“写入”用途。 示例代码：Option ExplicitSub btnADO_Click() On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Dim xADOCon As Variant Dim xADORs As Variant Dim xSQLStr As String Dim I As Long ThisWorkbook.Names.Item("Result").RefersToRange.ClearContents '创建数据库连接 Set xADOCon = CreateObject("Adodb.Connection") ' 打开数据库连接 ' 2007及以后版本 xADOCon.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties='Excel 12.0; HDR=YES; IMEX=1'" ' 2003及以前版本 'xADOCon.Open "Provider=Microsoft.jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties='Excel 8.0; HDR=YES; IMEX=1'" ' 设置SQL语句 xSQLStr = "SELECT * FROM [Data_1$] WHERE 姓名='王二' OR 姓名='马五' AND 年龄>30" ' 将SQL语句获得的数据传递给数据集 Set xADORs = xADOCon.Execute(xSQLStr) ' 获得SQL结果的列标题 For I = 1 To xADORs.Fields.Count ThisWorkbook.Names.Item("Result").RefersToRange.Cells(1, I) = xADORs.Fields(I - 1).Name Next ThisWorkbook.Names.Item("Result").RefersToRange.Range("a2").CopyFromRecordset xADORs '关闭数据库连接 xADOCon.Close Set xADOCon = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Excel VBA 窗体之工具栏式窗体(小标题窗体)实现代码
在 VBE 编辑器中，我们能看到很多的小标题栏窗体，这就是工具栏窗体，其实我们通过对VBA用户窗体的定制，也可以使VBA的用户窗体成为工具栏式窗体。本文就是运用API函数来定制 Office 中的用户窗体，使其成为工具栏窗体。附件下载：点击链接从百度网盘下载操作如下： ◾在Excel 的VBE窗口中插入一个用户窗体，将其命名为 frmTools。在用户窗体中添加两个按钮，然后再添加一个模块。在窗体和模块中添加后面所列代码。 ◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其 设置宏 为 btnToolsForm_Click。其供示范之用.具体代码："ModToolsForm" 模块代码Sub btnToolsForm_Click() frmTools.Show End Sub"frmTools" 窗体代码Option Explicit '*************************************** '---此模块演示了一个工具栏窗体--- '*************************************** '以下声明API函数 #If Win64 Then '64位 Private Declare PtrSafe Function FindWindow _ Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) _ As LongPtr Private Declare PtrSafe Function GetWindowLongPtr _ Lib "user32" _ Alias "GetWindowLongPtrA" ( _ ByVal hwnd As LongPtr, _ ByVal nIndex As Long) _ As LongPtr Private Declare PtrSafe Function SetWindowLongPtr _ Lib "user32" _ Alias "SetWindowLongPtrA" ( _ ByVal hwnd As LongPtr, _ ByVal nIndex As Long, _ ByVal dwNewLong As LongPtr) _ As LongPtr Private Declare PtrSafe Function DrawMenuBar _ Lib "user32" ( _ ByVal hwnd As LongPtr) _ As Long #Else '32位 '查找窗口 Private Declare Function FindWindow _ Lib "User32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) _ As Long '取得窗口样式位 Private Declare Function GetWindowLong _ Lib "User32" _ Alias "GetWindowLongA" ( _ ByVal Hwnd As Long, _ ByVal nIndex As Long) _ As Long '设置窗口样式位 Private Declare Function SetWindowLong _ Lib "User32" _ Alias "SetWindowLongA" ( _ ByVal Hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) _ As Long '重绘窗体标题栏 Private Declare Function DrawMenuBar _ Lib "User32" ( _ ByVal Hwnd As Long) _ As Long #End If #If Win64 Then '64位 Private FHwnd As LongPtr Private FIstype As LongPtr #Else Private FHwnd As Long Private FIstype As Long #End If '以下定义常数 Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_TOOLWINDOW = &H80& '**************************************** '---主程序--- '****************************************Private Sub btnClose_Click() Unload Me End SubPrivate Sub btnReset_Click() #If Win64 Then '64位 '取得拓展窗口样式位 FIstype = GetWindowLongPtr(FHwnd, GWL_EXSTYLE) '拓展窗体样式位: 原样式无工具栏窗口样式 FIstype = FIstype And Not WS_EX_TOOLWINDOW '重设拓展窗体样式位 SetWindowLongPtr FHwnd, GWL_EXSTYLE, FIstype '重绘窗体标题栏 DrawMenuBar FHwnd #Else '取得拓展窗口样式位 FIstype = GetWindowLong(FHwnd, GWL_EXSTYLE) '拓展窗体样式位: 原样式无工具栏窗口样式 FIstype = FIstype And Not WS_EX_TOOLWINDOW '重设拓展窗体样式位 SetWindowLong FHwnd, GWL_EXSTYLE, FIstype '重绘窗体标题栏 DrawMenuBar FHwnd #End If End Sub
Excel VBA 窗体之特殊形状窗体 任意形状窗体 实现代码
在Excel中当我们有时需要一些特殊形状的窗体，如果是几何形状组合的窗体，那么我们可以使用定制化窗体之特殊形状窗体一：几何形状组合窗体中的方法来实现。但有时我们需要显示一个文字窗口，或者显示一幅镂空图画的窗体，或者任意形状的窗体，那又怎么做呢？制作思路：◾你首先需要准备一张图片，在图片上画出你需要显示的图形或文字等，然后将图片上需要透明的部分设置为同一种颜色（在示例中我用的是白色）。之后在窗体初始化时载入此图片，并将窗体的PictureSizeMode属性设置为1fmPictureSizeModeStretch。◾然后在窗体初始化时用FindWindow取得窗体的句柄，再用GetWindowLong取得窗体的样式位和拓展样式位。用SetWindowLong设置窗体新的样式位和拓展样式位（无标题栏和边框）。以达到去除窗体标题栏和边框的效果。◾接下来最重要的部分就是使我们不需要的那部分窗体透明。这里我们将用到一个API函数SetLayeredWindowAttributes。我们将函数中的参数crKey设为你需要透明部分的颜色。参数bAlpha设为0~255之间的任意值（这里将忽略此参数）。参数dwFlags设为LWA_COLORKEY，以达到使窗体镂空显示的效果。附件下载：点击链接从百度网盘下载操作如下：◾在Excel的VBE窗口中插入一个用户窗体，将其命名为EspecialForm。然后再添加一个模块。在窗体和模块中添加后面所列代码。◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其设置宏为ShowForm。其供示范之用
excel VBA语句之select判断语句使用
今天教大家一些，在VBA当中的select判断语句的使用的具体操作方法和场景。一、select语句单一条件判断：Sub select单条件判断()i = 1Select Case iCase Is > 0MsgBox "正数"Case ElseMsgBox "负数"End Select
excel VBA教程：秒杀汇总几十张销售通知单
每天都会收到同事提报的销售清单数据，每天的表里都有几十张SHEET，她需要每天将这几十张SHEET中的部分数据粘贴成一张日清单总表。她日复一日的重复着这些工作，如此无意义的体力劳动，让她深感疲倦。于是她问我有没有什么办法可以快速将这些分表数据弄到总表中去。也就是说她要将下图 【图1】中的数据自动粘贴到总表中去，即【图2】的效果。 【图1】源表如下：↓