博文
使用VBA制作数组的排序(2006-07-04 13:24:00)
摘要：在模块中添加：
Sub BobbleSort(list() As String)
Dim First As Integer, Last As IntegerDim temp As StringFirst = LBound(list) '取数组上界Last = UBound(list) '取数组下界For i = First To Last - 1 For j = i + 1 To Last If list(i) > list(j) Then temp = list(j) list(j) = list(i) list(i) = temp End If Next jNext iEnd Sub
Public Sub sort1()Dim list1(10) As StringFor i = 0 To 10 list1(i) = Cells(i + 1, 1)Next iBobbleSort list1For i = 1 To 10 Cells(i + 1, 2) = list1(i)Next iEnd Sub......
制作和EXCEL内部函数一样的VBA函数[ZT](2006-06-09 10:05:00)
摘要：我们知道，Excel中函数都有一个说明，帮助使用，我们也要给这个函数添加一个说明。在工具栏中选择“对象浏览器”，选择我们所做Tax模块，在其[右键]→[属性]中添加关于对这个函数的描述，这个描述将出现在Excel中关于函数的说明中，如果你要对软件保密的话，在“模块”上按右键，[VBAproject属性]→[保护中设置密码]，嘿嘿！别人就看不到你的源程序了。这时，退出，回到Excel界面，将这个文件另存为：类型为“Microsoft Excel 加载宏”，在Excel 2000中，它会自动更改保存位置为c:\windows\application data\microsoft\addins(系统装在c:\windows），当然，你也可以把这个文件tax.xla，直接复制到office\library（office的安装路径下），而在Excel 97中只能放在后一个位置。使用函数很简单，点击[工具]→[加载宏]，在你创建的Tax前打个勾，在单元格直接输入“=tax()”，是不是像Microsoft office提供的函数一样，很有点专业味道。假如你把调用这个宏的Excel文件拷贝到别的机子上运行，会出现“当前所要打开的文档含有其他文档的链接，是否要使用其他工作簿中的改动更新当前工作簿”的提示，可以显示原先计算的数据，这是因为在Excel中的[工具]→[选项]→[重新计算]中，一般选中“保存外部链接数据”，但你不能重新计算，因为不能链接这个宏，别人机子上根本就没有这个函数。只不过在“加载宏”时，我自己创建的函数，是一个英文标题，而且下面也没有说明，你是不是觉得有点不够专业。跟我来，再教你一招，如果你使用的是Excel 2000时，找到tax.xla，点击[右键]→[属性]→[摘要]，在描述里添加所需内容来对函数进行相关描述，其中“标题”部分将出现在“加载宏”的方框中，“备注”部分将出现在下面的函数说明部分。这时再看看，够不够专业。在Excel 97中也可以在其右键属性中作相应更改。
把你自己的自定义函数加到特定函数分类中
示例本示例将用户定义的宏“TestMacro”添加到名为“My Custom Category”的自定义类别中。运行本示例后，可以看到包含“TestMacro”用户定义函数的“My Custom Category”显示在“插入函数”对话框的“或选择类......
用VBA在EXCEL中搜索显示ACCESS数据库内容(2006-06-05 16:25:00)
摘要：首先建立一个ACCESS数据库，名字为TEST.MDB，里面建立一个“telephone”的表，字段有 "姓名"公司""座机"等，并加入几条记录，保存在D盘。
在EXCEL的VB编辑器中，插入一个模块，输入搜索数据库函数：
Public Sub Serchmdb(ByVal so, si As String) Dim cmd As String Dim oAss As Object connstr = "DBQ=D:\test.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};" Set oAss = CreateObject("ADODB.connection") oAss.Open connstr cmd = "SELECT * FROM telephone WHERE " + si + " like '%" + so + "%'" On Error GoTo 0 Set rs = oAss.Execute(cmd) btop = 4 bleft = 2 Range("A2:Z1000").ClearContents Cells(btop, bleft + 1) = "序号" Cells(btop, bleft + 2) = "姓名" Cells(btop, bleft + 3) = "公司" Cells(btop, bleft + 4) = "座机" Do While Not rs.EOF btop = btop + 1 Cells(btop, bleft + 1) = rs("id") Cells(btop, bleft + 2) = rs("姓名") Cells(btop, bleft + 3) = rs("公司") Cells(btop, bleft + 4) = rs("座机") rs.movenext Loop rs.CloseEnd Sub
在EXCEL页面上加一个文本框（TextB......
用VBA在EXCEL上制作一个汉字表(2006-06-01 13:53:00)
摘要：在EXCEL中，按Alt＋F11，弹出VB编辑器，插入一个模块，在空白窗口中输入：
Public Sub Allword()Range("A1:CQ74").ClearContentsColumns("A:CQ").ColumnWidth = 2.25Rows(1).Font.Size = 8Columns(1).Font.Size = 8For i = 161 To 254 Cells(1, i - 159) = iNext
For m = 176 To 247 Cells(m - 174, 1) = m For n = 161 To 254 mn = "&H" & Hex(m) & Hex(n) a = m - 174 b = n - 159 Cells(a, b).Value = Chr(mn) NextNext
End Sub
执行这个宏过程，就可以在页面上看到一个汉字表。......
通过VBA制造EXCEL的菜单(2)(2006-05-29 13:09:00)
摘要：之前《通过VBA制造EXCEL的菜单》的程序代码做了一大堆无用功，今天发现原来可以以这样更简单更好的代码来实现：
1。新建EXCEL文件，按“Alt”＋“F11”进入VB编辑器，点“ThisWorkBook”打开空白窗口，在其中输入以下代码：
Const LineNum As Integer = 23 '按钮行数Const ListNum As Integer = 44 '按钮列数
Private Sub Workbook_BeforeClose(Cancel As Boolean)For jj = 1 To LineNum DelName = "菜单" & jj On Error Resume Next Application.CommandBars(DelName).DeleteNextEnd Sub
Private Sub Workbook_Open()For jj = 1 To LineNum AddBars jjNextEnd Sub
Public Sub AddBars(BarIndex)Dim tbar As CommandBarBarName = "菜单" & BarIndexSet tbar = Application.CommandBars.Add(Name:=BarName, Position:=msoBarBottom)tbar.Visible = TrueFor k = 1 To ListNum On Error Resume Next AddButton BarIndex, k, BarNameNextEnd Sub
Public Sub AddButton(BarIndex, BtnIndex, BarName)Dim Btn As CommandBarButtonii = BarIndex * ListNum + BtnIndexButtonName = "按钮" & iiSet Btn = Application.CommandBars(BarName).Controls.AddWith Btn .TooltipText = "ID:" & ii .FaceId = iiEnd WithEnd ......
用VBA列出excel的所有按钮(2006-05-29 11:50:00)
摘要：新建一个EXCEL文件，按“Alt”+"F11"，在出现的树状菜单中点击“ThisWorkBook”，在弹出的空白窗口中输入以下代码：
Private Sub Workbook_BeforeClose(Cancel As Boolean)On Error Resume NextApplication.CommandBars("ttt").DeleteEnd Sub
Private Sub Workbook_Open()Set cbr = Application.CommandBars.Add(Name:="ttt", Position:=msoBarTop, Temporary:=True)cbr.Visible = TrueFor k = 1 To 4000 On Error Resume Next cbr.Controls.Add ID:=kNextOn Error GoTo 0End Sub
保存后，退出EXCEL.
重新打开这个EXCEL文件，点击"启用宏".......
通过VBA制造EXCEL的菜单(2006-05-26 16:37:00)
摘要：通过EXCEL的宏制造菜单的测试。
1。新建一个EXCEL文件，点菜单“工具”－“宏”—“VB编辑器”。
2。点击树状菜单中的“ThisWorkBook”。
3。在弹出的窗口中输入以下代码：
Dim butt0, butt1, butt2, butt3, butt4, butt5, butt6, butt7, butt8, butt9Dim butt10, butt11, butt12, butt13, butt14, butt15, butt16, butt17, butt18, butt19
Private Sub Workbook_BeforeClose(Cancel As Boolean)Application.CommandBars("菜单1").DeleteApplication.CommandBars("菜单2").DeleteApplication.CommandBars("菜单3").DeleteApplication.CommandBars("菜单4").DeleteApplication.CommandBars("菜单5").DeleteApplication.CommandBars("菜单6").DeleteApplication.CommandBars("菜单7").DeleteApplication.CommandBars("菜单8").DeleteApplication.CommandBars("菜单9").DeleteApplication.CommandBars("菜单10").DeleteApplication.CommandBars("菜单11").DeleteApplication.CommandBars("菜单12").DeleteEnd Sub
Private Sub Workbook_Open()Set tbar1 = Application.CommandBars.Add(Name:="菜单1", Position:=msoBarBottom)Set tbar2 = Application.CommandBars.Add(Name:="菜单2", Position:=msoBarBottom)Set tbar3 = Application.CommandBars.Add(Name:="菜单3", Posit......
在EXCEL中将数字转换为人民币大写的三种方式(2006-05-18 10:21:00)
摘要：鉴于EXCEL本身提供将数字转换为大写表示的功能根本不能正常应用在实际投标或财务应用之中，所以要自己建设，暂时找到了三种实现途径，经过测试均功能正常，还有一种是在书上找到的，懒得KEYIN进来了，反正也差不多了。
方法1，通过在EXCEL表格框（例如在“B1”单元）中直接输入以下公式：
=IF(A1<0,"金额为负无效",(IF(OR(A1=0,A1=""),"(人民币)零元",IF(A1<1,"(人民币)",TEXT(INT(A1),"[dbnum2](人民币)G/通用格式")&"元"))))&IF((INT(A1*10)-INT(A1)*10)=0,IF(INT(A1*100)-INT(A1*10)*10=0,"","零"),(TEXT(INT(A1*10)-INT(A1)*10,"[dbnum2]")&"角"))&IF((INT(A1*100)-INT(A1*10)*10)=0,"整",TEXT((INT(A1*100)-INT(A1*10)*10),"[dbnum2]")&"分")
然后在“A1”中输入数字，就可看到效果。
方法2，通过VBA（宏）输入转换公式: 点击菜单“工具”->“宏”->“VisualBasic编辑器”,在编辑器窗口中，点击菜单“插入”->“模块”，在出现的窗口中输入以下内容：
Function daxie(ByVal Num) ' 人民币中文大写函数 Application.Volatile True Place = "分角元拾佰仟万拾佰仟亿拾佰仟万" Dn = "壹贰叁肆伍陆柒捌玖" D1 = "整零元零零零万零零零亿零零零万" If Num < 0 Then FuHao = "（负）" Num = Format(Abs(Num), "###0.00") * 100 If Num > 999999999999999# Th......