目录
一、引用 (3)
二、Worksheet_Change事件： (3)
三、相乘 (5)
四、相减 (6)
五、高级筛选 (6)
六、双击事件 (8)
七．单位汇总（sumif），单条件汇总 (10)
八、多条件汇总（连接、sumif） (13)
九、多条件汇总、ado (15)
十、对账 (16)
十一、sql筛选 (20)
十二、sql连接、交叉汇总 (21)
十三、select语句总结 (23)
十四、报表（有层次） (24)
一、引用
相对引用B4
绝对引用$B$4
混合引用$B4、B$4
F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。
二、Worksheet_Change 事件：
1.在单元格中C4=VLOOKUP(B4,简码表
2. Worksheet_Change事件代码：
Private Sub Worksheet_Change(ByVal Target As Range)
On error resume next
If Target.Row > 3 And Target.Column = 2 Then
i = Target.Row
Cells(i, 3) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets("简码表
").Range("b4:c100"), 2, False)
End If
End Sub
备查代码：
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row > 3 And Target.Column = 5 Then
i = Target.Row
Cells(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 If
End Sub
三、相乘
Sub 计算金额()
Application.ScreenUpdating = False
Dim i As Long
Dim irow As Long
irow = Range("a3").End(xldown).Row
For i = 4 To irow
Cells(i, 3) = Cells(i, 1) * Cells(i, 2)
Next i
Application.ScreenUpdating = True
End Sub
四、相减
Sub 相减()
Application.ScreenUpdating = False
Range("c3:c10000").ClearContents
Dim i As Long
Dim irow As Long
irow = Range("a5000").End(xlUp).Row
For i = 3 To irow
Cells(i, 3) = VBA.Round((Cells(i, 1) - Cells(i, 2)), 2)
Next i
Application.ScreenUpdating = True
End Sub
五、高级筛选（工具-宏-录制新宏，宏名改成高级筛选）
Sub 高级筛选()
Sheets("业务").Range("A3:I10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=ActiveCell.Range("A1:B1"), Unique:=True
End Sub
六、双击事件
1.插入-名称-定义（修改名称和引用位置）
2．查看代码-插入-用户窗体
工具箱-多页、列表框-右键属性
点击page1修改caption为资产类-点击空白列表框修改rowsource 为box1
依次类推
3. 业务表-查看代码 Worksheet beforedoubleclick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 Then
UserForm1.Show
Sheets("初始化").Range("m3") = ActiveCell
ElseIf Target.Row > 3 And Target.Column = 7 Then
UserForm2.Show
End If
End Sub
备查代码：
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 Then
UserForm1.Show
Sheets("初始化").Range("c2") = ActiveCell
ElseIf Target.Row > 3 And Target.Column = 7 Then
UserForm2.Show
Sheets("初始化").Range("f2") = ActiveCell
ElseIf Target.Row > 3 And Target.Column = 8 Then
UserForm3.Show
End If
End Sub
4．右键点击Userform1查看代码 Listbox1 dbclick
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox1.ListIndex, 0)
Unload Me
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox2.ListIndex, 0)
Unload Me
End Sub
Private Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox3.ListIndex, 0)
Unload Me
End Sub
Private Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox4.ListIndex, 0)
Unload Me
End Sub
Private Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox5.ListIndex, 0)
Unload Me
End Sub
见上图
5.插入用户窗体右键点击userform2 worksheet dblclick
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row, 7) = ListBox1.List(ListBox1.ListIndex, 0)
Unload Me
End Sub
Userform initialize
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
With Sheets("初始化")
Sheets("科目表").Range("h2:i10000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Range("m2:m3"), CopyToRange:=.Range("n2"), Unique:=True
End With
Application.ScreenUpdating = True
End Sub
七．单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇总!$A15,业务!I$4:I$10000)
Sub 单位汇总1()
Application.ScreenUpdating = False
range("a1:i10000").Clear
Cells(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:=True
Sheets("业务").Range("A3:J10000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("G1:G2"), CopyToRange:=Range("G3:I3"), Unique:=False
Dim i As Long
Dim irow As Long
irow = Range("a3").End(xlDown).Row
For i = 4 To irow
Cells(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 i
Range("g1:i10000").Clear
Application.ScreenUpdating = True
End Sub
八、多条件汇总（连接、sumif）
连接=k4&l4&m4&n4
Vba：
Sub 多条件汇总()
Application.ScreenUpdating = False
Range("a1:p10000").Clear
Sheets("业务").Range("D3:G10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("B3:E3"), Unique:=True
Sheets("业务").Range("D3:I10000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("K3:P3"), Unique:=False
Dim j As Long
Dim jrow As Long
jrow = Range("k3").End(xlDown).Row
For j = 4 To jrow
Cells(j, 10) = Cells(j, 11) & Cells(j, 12) & Cells(j, 13) & Cells(j, 14)
Next j
Dim i As Long
Dim irow As Long
irow = Range("b3").End(xlDown).Row
For i = 4 To irow
Cells(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 i
Range("i3:p10000").Clear
Range("a1:a10000").Delete
Application.ScreenUpdating = True
End Sub
九、多条件汇总、ado
Sub 多条件汇总()
Application.ScreenUpdating = False
Dim i As Integer
Dim strsql As String
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullName
strsql = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标,sum(拨款数) as 预算股拨款 from[业务$a3:J10000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"
rst.Open strsql, cnn
For i = 1 To rst.Fields.Count
Sheets("多条件汇总").Cells(3, i) = rst.Fields(i - 1).Name Next i
Sheets("多条件汇总").Range("a4").CopyFromRecordset rst rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
End Sub
十、对账
Sub 预算股()
Application.ScreenUpdating = False
Dim i As Integer
Dim strsql1 As String
Dim cnn1 As New ADODB.Connection
Dim rst1 As New ADODB.Recordset
cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullName
strsql1 = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标 from[预算股$a3:m50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst1.Open strsql1, cnn1
For i = 1 To rst1.Fields.Count
Sheets("对帐").Cells(3, i + 10) = rst1.Fields(i - 1).Name
Next i
Sheets("对帐").Range("k4").CopyFromRecordset rst1
rst1.Close
cnn1.Close
Set rst1 = Nothing
Set cnn1 = Nothing
Dim strsql2 As String
Dim cnn2 As New ADODB.Connection
Dim rst2 As New ADODB.Recordset
cnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullName
strsql2 = " SELECT 单位,类,款,项, sum(指标数) as 专业股指标 from[专业股$a3:j50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst2.Open strsql2, cnn2
For i = 1 To rst2.Fields.Count
Sheets("对帐").Cells(3, i + 19) = rst2.Fields(i - 1).Name
Next i
Sheets("对帐").Range("t4").CopyFromRecordset rst2
rst2.Close
cnn2.Close
Set rst2 = Nothing
Set cnn2 = Nothing
s = Application.WorksheetFunction.CountA(Range("k4:k10000")) + 4
Range("T4:W10000").Select
Selection.Copy
Range("K" & s).Select
ActiveSheet.Paste
Range("X4:X10000").Select
Selection.Copy
Range("P" & s).Select
ActiveSheet.Paste
Range("X3").Select
Selection.Copy
Range("P3").Select
ActiveSheet.Paste
Dim strsql As String
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullName
strsql = " SELECT 单位,类,款,项, sum(预算股指标) as 预算股指标 ,sum(专业股指标) as 专业股指标 from[对帐$k3:p50000] GROUP BY 单位,类,款,项"
rst.Open strsql, cnn
For i = 1 To rst.Fields.Count
Sheets("对帐").Cells(3, i) = rst.Fields(i - 1).Name
Next i
Sheets("对帐").Range("a4").CopyFromRecordset rst
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
End Sub
十一、sql筛选
Sub 筛选()
Application.ScreenUpdating = False
Dim i As Integer
Dim strsql As String
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullName
strsql = " SELECT distinct 单位,类,款,项 from[专业$a3:h10000]"
rst.Open strsql, cnn
For i = 1 To rst.Fields.Count
Sheets("筛选").Cells(3, i) = rst.Fields(i - 1).Name
Next i
Sheets("筛选").Range("a4").CopyFromRecordset rst
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
End Sub
十二、sql
Sub CombineWorkbooks() Dim FilesToOpen, ft Dim x As Integer Application.ScreenUpdating = False On Error GoTo errhandler FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Micrsofe Excel文件(*.xls), *.xls", _ MultiSelect:=True, Title:="要合并的文件") If TypeName(FilesToOpen) = "boolean" Then MsgBox "没有选定文件" 'GoTo errhandler End If x = 1 While x <= UBound(FilesToOpen) Set wk = Workbooks.Open(Filename:=FilesToOpen(x)) wk.Sheets().Move after:=ThisWorkbook.Sheets _ (ThisWorkbook.Sheets.Count) x = x + 1 Wend MsgBox "合并成功完成！" errhandler: 'MsgBox Err.Description 'Resume errhandler End Sub Sub MacroC1() ' ' MacroC1 Macro ' ' Sheets("报表1-MME容量及业务量报表").Select Range("D6").Select ActiveCell.FormulaR1C1 = " =D5/10000" Range("D6").Select ActiveCell.FormulaR1C1 = "=R[-1]C/10000" Range("D6").Select Selection.NumberFormatLocal = "0.00" Selection.Copy
Application（Excel程序）篇 Application.EnableEvents= True/ False ?启用/禁用所有事件 Application.DisplayAlerts=True/False ?显示/关闭警告框提示框 Application.ScreenUpdating= True/False ?显示/关闭屏幕刷新 Application.StatusBar = "软件报专用" ?在地址栏中显示文本，标题栏用Caption属性 Application.Cursor = xlIBeam …设置光标形状为Ⅰ字形，xlWait为沙漏(等待)形，xlNormal为正常Application.WindowState = xlMinimized …窗口最小化，xlMaximized最大化，xlNormal为正常Application.ActivateMicrosoftApp xlMicrosoftWord ?开启Word应用程序 Application.TemplatesPath …获取工作簿模板的位置 Application.CalculateFull ?重新计算所有打开的工作簿中的数据 Application.RecentFiles.Maximum = 2 ?将最近使用的文档列表数设为2 Application.RecentFiles(3).Open ?打开最近打开的文档中的第3个文档 Application.AutoCorrect.AddReplacement "sweek", "软件报" ?自动将输入的"sweek"更正为"软件报" Application.Dialogs(xlDialogPrint).Show …显示打印文档的对话框 Application.OnTime Now + TimeValue("00:00:45"), "process" ?45分钟后执行指定过程 Application.OnTime TimeValue("14:00:00"), " process " ?下午2点执行指定过程 Application.OnTime EarliestTime:=TimeValue("14:00:00"), _ Procedure:="process", Schedule:=False ?取消指定时间的过程的执行 工作簿/工作表篇 ActiveWorkboo k.Sheets.Count ?获取活动工作薄中工作表数 ActiveWorkbook.LinkSources(xlExcelLinks)(1) …返回当前工作簿中的第一条链接 ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetHidden …隐藏工作表，与在Excel菜单中执行“格式—工作表—隐藏”操作一样 ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVeryHidden …隐藏工作表，不能通过在Excel菜单中执行“格式—工作表—取消隐藏”来重新显示工作表 ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVisible …显示被隐藏的工作表 ThisWorkbook.Sheets(1).ProtectContents …检查工作表是否受到保护 ActiveSheet.Columns("B").Cut ActiveSheet.Columns("F").Insert …以上两句将B列数据移至F列，原C列后的数据左移 ActiveSheet.Range(“A:A”).EntireColumn.AutoFit …自动调整当前工作表A列的列宽 ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlTextValues) …选中当前工作表中常量和文本单元格ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlErrors+xlTextValues) …选中当前工作表中常量和文本及错误值单元格
VBA入门系列讲座 1.1 VBA是什么 直到90年代早期,使应用程序自动化还是充满挑战性的领域.对每个需要自动 化的应用程序,人们不得不学习一种不同的自动化语言.例如:可以用excel的宏语言来使excel自动化,使用word BASIC使word自动化,等等.微软决定让它开 发出来的应用程序共享一种通用的自动化语言--------Visual Basic For Application(VBA),可以认为VBA是非常流行的应用程序开发语言VASUAL BASIC 的子集.实际上VBA是”寄生于”VB应用程序的版本.VBA和VB的区别包括如下 几个方面: 1. VB是设计用于创建标准的应用程序,而VBA是使已有的应用程序(excel 等)自动化 2. VB具有自己的开发环境,而VBA必须寄生于已有的应用程序. 3. 要运行VB开发的应用程序,用户不必安装VB,因为VB开发出的应用程序 是可执行文件(*.EXE),而VBA开发的程序必须依赖于它的”父”应用程 序,例如excel. 尽管存在这些不同,VBA和VB在结构上仍然十分相似.事实上,如果你已经了解 了VB,会发现学习VBA非常快.相应的,学完VBA会给学习VB打下坚实的基础.而且,当学会在excel中用VBA创建解决方案后,即已具备在word access OUTLOOK 中用VBA创建解决方案的大部分知识. FOXPRO PROWERPOINT VBA一个关键特征是你所学的知识在微软的一些产品中可以相互转化. VBA可以称作excel的“遥控器”. VBA究竟是什么?更确切地讲,它是一种自动化语言,它可以使常用的程序自动化,可以创建自定义的解决方案. 此外,如果你愿意,还可以将excel用做开发平台实现应用程序. 1.2 Excel环境中基于应用程序自动化的优点 也许你想知道VBA可以干什么?使用VBA可以实现的功能包括: 1. 使重复的任务自动化. 2. 自定义excel工具栏,菜单和界面. 3. 简化模板的使用. 4. 自定义excel,使其成为开发平台. 5. 创建报表. 6. 对数据进行复杂的操作和分析.
VBA程序教学用例 【例1】求解一元二次方程Ax2+Bx+C=0。 顺序结构的VBA程序： SUB JFC1() A = Sheets("解一元二次方程").Cells(1, 2) B = Sheets("解一元二次方程").Cells(2, 2) C = Sheets("解一元二次方程").Cells(3, 2) X1=(-B+SQR(B^2-4*A*C))/2/A X2=(-B-SQR(B^2-4*A*C))/2/A DEBUG.PRINT “X1=”,X1 DEBUG.PRINT “X2=”,X2 END SUB 提示：先将三个系数A、B、C存放到表"解一元二次方程"的单元格B1:B3中，运行结果在立即窗口中（可用CTRL+G组合键打开立即窗口）。 带判断条件的VBA程序： Sub JFC2() A = Sheets("解一元二次方程").Cells(1, 2) B = Sheets("解一元二次方程").Cells(2, 2) C = Sheets("解一元二次方程").Cells(3, 2) If B * B - 4 * A * C >= 0 Then Sheets("解一元二次方程").Cells(4, 2) = (-B + Sqr(B ^ 2 - 4 * A * C)) / 2 / A Sheets("解一元二次方程").Cells(5, 2) = (-B - Sqr(B ^ 2 - 4 * A * C)) / 2 / A Else Sheets("解一元二次方程").Cells(4, 2) = "此方程无实根" Sheets("解一元二次方程").Cells(5, 2) = "此方程无实根" End If End Sub 提示：先将三个系数A、B、C存放到表"解一元二次方程"的单元格B1:B3中，运行结果在B4:B5中）。
Excel VBA编程VBA程序的运行方式 为了测试和调试一个程序，需要了解程序当前处于三种模式中的哪一种模式。其中，VBA程序的三种模式即表示VBA程序的3种运行方式，分别为设计模式、运行模式和中断模式。1．设计模式 所谓设计模式是指工程中的过程代码不能被执行且来源于主应用程序或工程中的事件也不能被执行。用户可以使用运行宏或使用“立即窗口”来退出“设计模式”。 单击VBE窗口中的【设计模式】按钮，即可变为【退出设置模式】按钮。或者单击【运行】菜单，执行【设计模式】命令，此时，【运行】菜单下变为【退出设置模式】命令，其区别在于： ●设计模式打开设计模式并且改变成“退出设计模式”。 ●退出设计模式关闭设计模式并清除工程中所有模块层次的变量。 2．运行模式 所谓运行模式是指代码处于运行阶段。用户按下F5功能键，或者单击【标准】工具栏上的【运行宏】按钮时，即可进入运行模式。此时，标题栏上显示“正在运行”。在此过程中，可以查看程序代码，不可以进行编辑修改代码。 3．中断模式 当出现语法错误或运行时错误时，程序将处于中断模式。所谓中断模式是指在开发环境中暂时中止程序的执行。在中断模式下，可以检查、调试、重置、单步执行或继续执行程序。在以下情况中可进入中断模式： ●在执行程序时遇到断点。 ●在执行程序时按下CTRL+BREAK。 ●在执行程序时遇到Stop语句或未捕获的运行时错误。 ●添加一个Break When True监视表达式，当监视的值改变时将停止执行且值为True。 ●添加一个Break When Changed监视表达式，当监视的值改变时将停止执行。 提示语法错误是指在输入一行不能识别的VBA代码时发生的错误。而运行时错误是指在代码正在运行时发生的错误。例如，当一语句要进行非法操作时就会发生运行时错误。
Option Explicit Option Base 1 Const servername = "OPCServer.WinCC" Dim WithEvents MyOPCServer As OPCServer Dim WithEvents MyOPCGroup As OPCGroup Dim MyOPCGroupColl As OPCGroups Dim MyOPCItemColl As OPCItems Dim MyOPCItems As OPCItems Dim MyOPCItem As OPCItem Dim clienthandles(6) As Long Dim ServerHandles() As Long Dim Values(1) As Variant Dim Errors() As Long Dim ItemIDs(6) As String Dim GroupName As String Dim NodeName As String Dim itemv(6) As Variant Dim ii As Integer '华丽的分割线—————————————————— 'Sub StartClient() '目的：链接至OPC_server，创建组和添加条目'——————————————————————————————————————华丽的分割线 Sub StartClient() ' On Error Goto ErrorHandler '---------------可以自由选择ClientHandle和GroupName For ii = 1 To 6 clienthandles(ii) = ii Next ii GroupName = "MyGroup" '-------------从单元"A1"得到ItemID NodeName = Range("C2").Value ItemIDs(1) = Range("c3").Value ItemIDs(2) = Range("c4").Value ItemIDs(3) = Range("c5").Value ItemIDs(4) = Range("c6").Value ItemIDs(5) = Range("c7").Value ItemIDs(6) = Range("c8").Value '----------------------------------得到一个OPC服务器的实例 Set MyOPCServer = New OPCServer MyOPCServer.Connect servername, NodeName Set MyOPCGroupColl = MyOPCServer.OPCGroups '-----------------为添加组设置缺省的激活状态 MyOPCGroupColl.DefaultGroupIsActive = True
Excel制作象棋vba源代码 ' The algorithm of judge and urgentpoint function are exported from one VC program which I downloaded from web. ' Sorry I can't remebered the program and the author name. ' The original VC program have three options for different level. I simplized it to the hardest one in this VBA sample. ' Dim m_Board(17, 17) As Integer Private Type Cpoint x As Integer y As Integer End Type Dim m_nType As Integer Dim iWho As Integer Private Sub Excelba_Click() End Sub Private Sub cmdStart_Click() Cells(17, 1) = "Start" Cells(17, 3) = 0 ' total number of stones 'clear the board Range(Cells(17 + 1, 1), Cells(17 + 15, 15)).Value = 0 'clear all picture in this sheet except for two orginal picture For Each ipic In ActiveSheet.Shapes If https://www.doczj.com/doc/bc1700974.html, <> "Picture 9" And https://www.doczj.com/doc/bc1700974.html, <> "Picture 10" And Left(https://www.doczj.com/doc/bc1700974.html,, 7) = "Picture" Then ipic.Delete End If Next 'start it If optComputer.Value = True Then Call drawit(8, 8, 1) Call setarray(8, 8, 1) Cells(17, 3) = 1 End If End Sub Private Sub optComputer_Click() Cells(17, 1) = "" Cells(17, 2) = 2 Cells(17, 3) = 0 End Sub Private Sub optYou_Click() Cells(17, 1) = "" Cells(17, 2) = 1 Cells(17, 3) = 0
EXCEL VBA程序开发 蓝草咨询的目标：为您提升工作业绩优异而努力，为您明天事业腾飞以蓄能！ 蓝草咨询的老师：都有多年实战经验，拒绝传统的说教，以案例分析，讲故事为核心，化繁为简，互动体验场景，把学员当成真诚的朋友！ 蓝草咨询的课程：以满足初级、中级、中高级的学员的个性化培训为出发点，通过学习达成不仅当前岗位知识与技能，同时为晋升岗位所需知识与技能做准备。课程设计不仅注意突出落地性、实战性、技能型，而且特别关注新技术、新渠道、新知识、创新型在实践中运用。 蓝草咨询的愿景：卓越的培训是获得知识的绝佳路径，同时是学员快乐的旅程，为快乐而培训为培训更快乐！目前开班的城市：北京、上海、深圳、苏州、香格里拉、荔波，行万里路，破万卷书！蓝草咨询的增值服务：可以提供开具培训费的增值税专用发票。让用户合理利用国家鼓励培训各种优惠的政策。报名学习蓝草咨询的培训等学员可以申请免费成为“蓝草club”会员，会员可以免费参加（某些活动只收取成本费用）蓝草club定期不定期举办活动，如联谊会、读书会、品鉴会等。报名学习蓝草咨询培训的学员可以自愿参加蓝草企业“蓝草朋友圈”，分享来自全国各地、多行业多领域的多方面资源，感受朋友们的成功快乐。培训成绩合格的学员获颁培训结业证书，某些课程可以获得国内知名大学颁发的证书和国际培训证书（学员仅仅承担成本费用）。成为“蓝草club”会员的学员，报名参加另外蓝草举办的培训课程的，可以享受该培训课程多种优惠。 课程背景： EXCEL中高级的应用培训已经可以解决工作上的大多数问题，然而还有很多操作无法实现，比如你想实现以下功能： 多个表格快速核对计算 数据每天扩展指定时间自动更新 快速将一个文件拆分成几百个文件 快速将几百个文件一键汇总 一键生成几十个图表并按指定的位置排列
VBA在word中调用windows程序的源代码利用VBA可以大大简化我们的手工劳动，提供一个在word中利用VBA调用windows程序的代码。供大家探讨。以计算器为例，考虑到winxp系统和win7中计算器程序所在目录不同，所以代码较长。可以直接复制下列代码，用VBA编辑器粘贴，再做成按钮即可。 步骤看下面吧 1、打开visal basic编辑器 2、复制代码，粘贴到……（看不清的话，放大一些，呵呵清晰度是必需的。） 3、点开“工具”的自定义
4、选择“计算器”，拖至菜单任意处，修改即可。
5、成功啦。。。。 附源代码： Sub 计算器() On Error GoTo lzhy Dim ReturnValue As String Dim ErrorNumber As Integer Dim n2 As Boolean Dim n3 As Boolean If (Dir("C:\WINDOWS\CALC.EXE") <> "") Then n2 = True Else: n2 = False End If If (Dir("C:\WINDOWS\System32\CALC.EXE") <> "") Then n3 = True Else: n3 = False End If If n2 = True Then ReturnValue = Shell("C:\WINDOWS\CALC.EXE", 1) AppActivate ReturnValue End If If n3 = True Then ReturnValue = Shell("C:\WINDOWS\System32\CALC.EXE", 1) AppActivate ReturnValue End If Exit Sub lzhy: ErrorNumber = Err.Number If ErrorNumber = 53 Then MsgBox "请先在“控制面板”内打开“添加／删除程序”，在“Windows安装程序”内的“附件”窗口中找到“计算器”选项选定后安装，此功能即可用。", vbCritical, "使用注意" End If End Sub Sub 画图程序()
PPT用VBA制作简单的选择题的方法及源码2 PPT用VBA制作简单的选择题的方法及源码 powerpoint中的vba可以实现很多复杂的交互，但很多老师面对vba编程，都会觉得无从下手。所以本期我们为大家安排了一个关于powerpoint中vba的小专题，以后在课件中实现交互就不会那么费劲了。 vba基础 说到vba编程，就不得不提到控件工具箱，我们需要利用其中的控件搭建需要的环境。 1( 显示控件工具箱 在powerpoint中选择菜单“视图/工具栏/控件工具箱”。 2( 控件工具箱(如图1)中常用按钮的介绍 (1)复选框(checkbox):可以选择多个选项，常用来设计多选题;(2)文本框(textbox):可以输入文本，常用来设计填空题;(3)命令按钮(commandbutton):用来确定选择或输入，也可设计超级链接;(4)单选框(optionbutton):只能选中一个选项，常用来设计单选题或判断题;(5)标签(label):用来显示文字信息。 ( 插入控件的方法 3 单击控件工具箱上的工具按钮，然后在幻灯片中拖动到适当大小即可。 4( 进入vba的方法 双击幻灯片中的控件或用菜单命令“工具/宏/visual basic编辑器”即可进入vba编程状态。 5( 控件的主要属性及设置方法
进入vba后，需要在“属性”窗口中对控件的属性进行设置。如果没有出现“属性”窗口，按f4键即可调出该窗口。下面我们就不同的控件，来说明常用属性的设置方法。 (1)复选框 autosize:有两个值，true表示根据字的多少调整复选框的大小，false表示复选框为固定大小;backcolor:设置复选框的背景颜色，单击该属性框出现下拉按钮，选择“调色板”选项卡后选择颜色;caption:控件的名称，把默认值删除再重新输入新名称;font:设置字体、字号及字形，单击该属性框出现按钮，单击该按钮出现字体对话框，再在对话框中设置;forecolor:设置字的颜色，设置方法同backcolor;height:复选框的高度，直接输入数字即可;width:复选框的宽度，直接输入数字即可;value:复选框的值，true为选中，false则相反。 (2)文本框 autosize、backcolor、font、forecolor、height、width等属性的设置方法同复选框;value:文本框的值，用来保存输入的文本;textalign:设置文本对齐方式。 (3)单选框 属性设置同复选框。 (4)标签 除value外，其他同复选框。 (5)命令按钮 同标签。 6( 消息框msgbox 的功能
初识VBA 既然题目是初识VBA，那么我想先给大家一个直观的感受——什么是VBA？，往往在一些EXCEL的教材中，都会讲：VBA是一种自动化语言,它可以使常用的程序自动化,可以创建自定义的解决方案。就我看书学习的经验来说，我感到这样的定义式的描述带有很典型的中国式教材的风格，然而却不能让人立即理解，那么这样的定义有什么用呢？我给VBA下的定义是：VBA是一些代码的组合。可能这个定义没有上面教材的定义那么严谨和准确，但我想你一看就应该能明白，原来VBA就是写代码，或者说就是写程序。（如果掌握了VBA，居然我也能写程序了~~惊喜吧？） 那么你用了这么久的EXCEL，可能从来没在EXCEL的XLS文件中看到过代码，难道就写在单元格里？那我就带你去找找，VBA的代码藏在哪里吧，这也正式我今天要谈的第二个问题。当你打开一个EXCEL文件，你只能看到由许多单元格组成的工作表，这时，你可以通过【视图】菜单的【工具栏】项目，打开一个工具栏，名字叫“控件工具箱”，从左往右属第三个按钮，名字叫“查看代码”，点一下，就可以打开VBA代码编辑窗口。更简单的方法是，通过【ALT】+【F11】的快捷键，打开VBA代码编辑窗口，看到了吧，原来代码就是藏在这里的哦~~~ 怎么写代码呢？你也太心急了点吧，你还没掌握命令、语法、关键字、对象、事件、属性等等内容，就想写代码？一口是吃不成个胖子的，还是让我来带你先认识下这里的每个角落吧，就像进了一间陌生的屋子，总归每个角落都得转到吧？最上面的几行，和EXCEL以及每一个微软平台下的应用程序都一样，总归是标题栏、菜单栏、工具栏等，接下来，看左边，有一个纵栏，写着“工程---VBAProject”，这里是工程资源管理窗口，里面通过树形列表展示了这个XLS文件（或者标准的应该叫“工作簿”）所包含的各个工作表对象以及工作簿对象本身。有什么用呢？
如何优化VBA代码并使程序尽可能快的运行 速度问题一直是VBA程序值得关注的一个方面。当您编写了一个对大量数据进行操作的程序后，在运行时可能会发现程序运行得很慢，有的甚至达好几分钟，就像Excel应用程序已崩溃了一样。但当您发现程序确实在运行，并得到正确的结果后，您可能就会想到如何使程序更快的运行了。当然，代码运行速度慢可能是VBA程序的一个缺点，这也可能是程序语言本身的一个原因，但我们也可以找到一些方法优化VBA代码并使程序尽可能快的运行。 下面是我整理的一些优化VBA代码或提高程序运行速度的方法，有些方法是我们在编程中好的做法和应该养成的好习惯，希望能带给您一些有益的参考。高质量的程序和运行效率是需要不断实践，并在实践中不断总结和积累经验的，也希望您能将在编写程序过程中发现的一些优化方法介绍给大家共享。 1、尽量简化代码 通过简化代码，可以提高程序的性能。您可以将通用过程编写为子过程来调用。例如，假设有一个应用程序需要在不同的地方实现查找一定范围内的某个特殊条目，在一个没有简化代码的应用程序中，不同的过程可能需要应用各自的算法以实现在某个范围内查找某一条目，修改每个过程使其采用一个更有效的算法并不是一件很容易的事。而一个简化的程序则只有一个查找算法，即将该查找算法编写成通用的子程序，需要查找某个范围的过程都调用该子程序，通过在查找方法的子程序中优化查找算法，使得调用该方法的所有过程都享受性能提高所带来的好处。 另外，删除所有无关的代码，这在所录制宏中表现得尤为明显。在录制宏时，经常会产生一些与所实现的功能无关的代码，您可以将这些代码删除，以使得代码得以简化。 在下面将要讲到的设置对象变量代替长对象引用，使用With…End With语句、执行For Each…Next循环语句，根据程序环境尽量减少OLE引用，等等，均是简化代码的好方法。 2、强制声明变量 在VBE编辑器中的菜单“工具——选项”对话框中“编辑器”选项卡中，您应该始终保持“要求变量声明”复选框被选中，这样将在模块代码顶部出现Option Explicit 语句，要求您在编写代码时对所有出现的变量均进行声明，这样，在使用变量时减少内存需求并加速性能。 (1)要节省内存资源，必须始终用特定的数据类型声明所有变量。如果不使用特定的数据类型声明变量，VBA会创建Variant类型的变量，这将比任何其他数据类型要求更多的内存。 (2)清楚每种数据类型需要多少内存以及它可以存储的值的范围。除使用较小的数据类型会导致隐性转换的情况外，应始终使用尽可能小的数据类型。例如，因为Integer类型的变量将被转换成Long类型的变量，应该将那些存储整型值的变量声明为Long类型，而不是Integer类型。 (3)除非确实需要，应避免使用浮点数据类型。尽管Currency数据类型更大，但它比Single 数据类型快，因为Currency数据类型不使用浮点处理器。 (4)如果在一个过程中多次引用一个对象，可以创建对象变量，并将对给对象的引用指派给它。因为对象变量存储对象在内存中的位置，VBA将不必再次查找其位置。 (5)将对象变量声明为特定的类型(不是Object类型)，以便利用早期绑定。
Excel VBA编程常用代码 时间:2009-12-0522:36:04来源:本站作者:未知我要投稿我要收藏投稿指南 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句 Dim a as integer'声明a为整型变量 Dim a'声明a为变体变量 Dim a as string'声明a为字符串变量 Dim a as currency,b as currency,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 msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0,1).Select'当前单元格向左移动一格
VBA的WEB应用系列教程——HTML文档篇 上节课，我们说了HTTP通讯，HTTP通讯一般情况返回的是啥呢？是页面的源代码。例如，我们访问百度，返回了，“…”一大堆东西。就是，我们在页面点击右键，“查看页面源文件”，如图： 我们的浏览器，正是把这堆源代码，翻译成我们可视的生动地页面的。就像VBA一样，这堆代码是什么语言呢，就是通常所说的，超文本标记语言。 为啥叫标记语言，因为它只能用于展示，展示我们所看到的网页页面。不是编程语言哦。 为啥叫超文本呢，大家仔细看，这堆源代码有什么特征呢，就是有很多<…>这样的文本，一般而言，我们把<…>叫做标签，细心的同学可以发现，标签都是成对出现的，例如“
总之，HTML就是用来描述网页的语言，像上面所说的
Dim ChkCode1 Private Sub CommandButton1_Click() Dim errMsg As Object Dim iCount As Integer, iTotal As Integer CommandButton1.Caption = "邮件正在发送中。。。" CommandButton1.Enabled = False '发送邮件按钮置灰 ChkCode1 = ChkCode Sheet1.Range("B2") = "系统验证码" Sheet1.Range("C2") = "您在" & DayTime & "获取的六位数验证码为:" & ChkCode1 & "，系统关闭前有效。" Worksheets("Sheet1").Select Range("A2").Select iCount = 0 iTotal = 0 Do While ActiveCell.Value <> "" Set errMsg = fSendEMailCDO(ActiveCell.Value, ActiveCell.Offset(0, 1).Value, ActiveCell.Offset(0, 2).Value, ActiveCell.Offset(0, 3).Value, ActiveCell.Offset(0, 4).Value, ActiveCell.Offset(0, 5).Value)
If errMsg.Number = 0 Then iCount = iCount + 1 End If iTotal = iTotal + 1 ActiveCell.Offset(1, 0).Select Loop If iCount = 0 Then CommandButton1.Caption = "邮件发送失败" MsgBox "发送失败，请重新发送" CommandButton1.Caption = "发送邮件" CommandButton1.Enabled = True '发送邮件按钮激活 Else CommandButton1.Caption = "邮件发送成功" MsgBox "发送成功，请登录邮箱查看验证码" End If End Sub '使用CDO发送邮件 Public Function fSendEMailCDO(strTo As String, strSubject As String, strBody As String, Optional strAttachment As String = "", Optional strCC As String = "", Optional strBCC As String = "") As Object Dim CDOMail As Variant
1.3 VBA代码编辑器（VBE） Visual Basic编辑器（VBE）是一个集成的开发环境，是我们查看、编辑、调试VBA程序的重要工具，熟悉和掌握VBE对于提高代码编写的速度，以及调试程序、迅速排除错误有着很重要的帮助。 打开Access数据库，选择菜单【工具】∣【宏】∣【Visual Basic 编辑器】，便进入VBE。 1.3.1 VBE窗口的分类及功能 编辑器中有很多窗口，它们可以以窗格的形式显示。用户可根据自己的习惯用鼠标拖动它们停靠在窗口任意位置，或者选择性的显示一些窗格，如图8-6与8-7所示。 图1-6 VBE窗口1 图1-7 VBE窗口2 代码窗口：代码窗口用来编写、显示以及编辑Visual Basic代码。过程与过程之间会
显示一条灰色横线以分割。 “过程查看”图标，显示所选的过程，同一时间只能在代码窗口中显示一个过程。“全模块查看”图标，显示模块中全部的代码。 立即窗口：立即窗口键入或粘贴一行代码，然后按下ENTER 键来执行该代码，立即窗口中的任何代码或者结果都不能够被存储。可以用鼠标把选定的代码在立即窗口与代码窗口之间相互拖放。程序中的“Debug.Print”语句也会将结果输出到立即窗口。 注意在立即窗口显示的信息容量是有限的，当使用大量Debug.Print语句时，可能看不到位于开头位置语句的打印结果。如果内容比较多，可以考虑将输入信息保存到一个指定的数据表中，以便事后进行观察和分析。 在中断模式下，立即窗口中的语句，是根据显示在过程框的内容或范围来执行的。我们往往用此来监视代码的执行情况。 本地窗口：本地窗口打开时，可自动显示出当前模块级别及在当前过程中的所有变量的声明及其当前值。 监视窗口：当工程中有定义监视表达式定义时，就会自动出现，窗口中列出了监视表达式及其值、类型与上下文。 1.3.2 对象浏览器 按下快捷键F2，可打开对象浏览器，显示出对象库以及这些对象库可供使用的对象、属性、方法、函数及常数。可以用它来搜索及使用内置的对象，或是来源于其他引用应用程序的对象，如图8-8所示。 图1-8 对象浏览器 不过，在立即窗口或者代码窗口中键入代码时，编辑器也会自动地显示出对象的属性、方法、常数。例如，在代码窗口中键入“Docmd.”，当这个小圆点打出的时候，会在光标的位置显示出一个小列表窗口，这里包含了这个对象的所有集合、方法、属性与常数，并可自动完成，如图8-9所示。
高考VBA程序设计解析 一、累加和问题： 1、基本问题 问题：编程计算1+2+3+ (100) 程序界面： 源代码: Private Sub Command3_Click() Dim s As Integer Dim i As Integer s = 0 For i = 1 To 100 Step 1 s = s + i Next i = s End Sub Private Sub Command4_Click() acForm, "VBA程序设计范例1" End Sub 2、问题拓展 拓展1：编程计算1+3+5+7+ (99) 源代码修改：
For i = 1 To 99 Step 2 s = s + i Next i 拓展2：编程计算2+4+6+8+ (100) 源代码修改： For i = 2 To 100 Step 2 s = s + i Next i 拓展3：编程计算1+2+3+…+N； 程序界面： 源代码： Private Sub Command10_Click() Dim i As Integer Dim s As Integer If Trim = Space(0) Then MsgBox "请输入N的值！", vbOKOnly Exit Sub ElseIf Val < 1 Then MsgBox "请输入大于1的正整数！", vbOKOnly Exit Sub End If s = 0 For i = 1 To Val Step 1 s = s + i Next i
= s End Sub 拓展4：编程计算1+(1+2)+(1+2+3)+(1+2+3+4)+…+(1+2+3+4+ …+100)； 程序界面： 源代码： Private Sub Command3_Click() Dim i As Integer, j As Integer Dim s1 As Integer, s2 As Double s1 = 0 s2 = 0 For i = 1 To 100 Step 1 s1 = 0 For j = 1 To i s1 = s1 + j Next j s2 = s2 + s1 Next i = s2 End Sub 拓展5：编程计算1+(1+3)+(1+3+5)+(1+3+5+7)+…+(1+3+5+7+ …+99)； 源代码： Private Sub Command3_Click() Dim i As Integer, j As Integer Dim s1 As Integer, s2 As Double s1 = 0 s2 = 0
工具栏和菜单栏 工具栏和菜单栏的运用更多时候是伴随着加载宏和个性Excel界面的出现而出现。在不断加深对Excel VBA的理解和运用，我们编程的思路渐渐会转到考虑代码的通用性和应用方案上，将代码和Excel数据源分开。因此，制作更多具有通用功能的加载宏（不管是xla加载宏，还是Com加载宏），可以最大极限的发挥VBA编程的魅力，而不是要求用户强制启用宏。也正是因为这个原因，在我们去学习工具栏和菜单栏时，要明白的一个道理是，制作工具栏仅仅是为了加载宏等具体运用的实现，不要一味地去追求工具栏的花哨。 一、几个基本概念 在开始本节之前，先理解什么是命令栏？ 命令栏（CommandBars）：是工具栏、菜单栏和快捷菜单的统称。 工具栏：带有按钮和选项的工具条，使用这些按钮和选项可执行命令。如下图： 菜单栏：标题栏下的水平栏，包括菜单名称。如下图 快捷菜单：又叫弹出式菜单，鼠标右键单击。如下图。 二、CommandBars集合对象 通过上面几幅图片的直观概念之后，我们接下来理解CommandBar集合。所有的工具栏和菜单栏代码都是围绕Commandbars集合展开的。 CommandBarControls集合包含三种类型控件。 CommandBarButton：代表命令栏中的一个按钮控件（按钮控件：工具栏上的按钮，或菜单、子菜单或快捷菜单上的菜单项，当单击它们时会运行一条命令。工具栏按钮和菜单项共享相同的属性和方法。）。该控件的 Type 属性必须是 msoControlButton。） CommandBarComboBox：代表命令栏中的一个组合框控件（组合框控件：菜单栏、工具栏、菜单、子菜单或快捷菜单上的自定义编辑框、下拉列表框或组合框。当工具栏垂直停靠时，它所包含的任何自定义组合框控件都不可见。）。该控件的Type 属性必须是msoControlEdit、msoControlDropdown、msoControlComboBox、msoControlButtonDropdown、msoControlSplitDropdown、msoControlOCXDropdown、msoControlGraphicCombo 或 msoControlGraphicDropdown。） CommandBarPopup：代表命令栏中的一个弹出式控件（弹出式控件：是菜单栏或工具栏上的内置或自定义控件，当单击它时显示菜单，或者是菜单、子菜单、或快捷菜单上的内置或自定义菜单项，当指针放在其上时显示子菜单。）。 该控件的 Type 属性必须是 msoControlPopup、msoControlGraphicPopup、msoControlButtonPopup、msoControlSplitButtonPopup 或 msoControlSplitButtonMRUPopup。 几种常见属性，参数和方法： Visible Name Type Postion Temporary Caption OnAction FaceID Style Enable Top/Left/Width/Hight BeginGroup