博文
使用VBA制作数组的排序(2006-07-04 13:24:00)
摘要：在模块中添加：
Sub BobbleSort(list() As String)
Dim First As Integer, Last As Integer
Dim temp As String
First = 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 j
Next i
End Sub
Public Sub sort1()
Dim list1(10) As String
For i = 0 To 10
list1(i) = Cells(i + 1, 1)
Next i
BobbleSort list1
For i = 1 To 10
Cells(i + 1, 2) = list1(i)
Next i
End 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......
用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) ......
用VBA在EXCEL上制作一个汉字表(2006-06-01 13:53:00)
摘要：在EXCEL中，按Alt＋F11，弹出VB编辑器，插入一个模块，在空白窗口中输入：
Public Sub Allword()
Range("A1:CQ74").ClearContents
Columns("A:CQ").ColumnWidth = 2.25
Rows(1).Font.Size = 8
Columns(1).Font.Size = 8
For i = 161 To 254
Cells(1, i - 159) = i
Next
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)
Next
Next
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).Delete
Next
End Sub
Private Sub Workbook_Open()
For jj = 1 To LineNum
AddBars jj
Next
End Sub
Public Sub AddBars(BarIndex)
Dim tbar As CommandBar
BarName = "菜单" & BarIndex
Set tbar = Application.CommandBars.Add(Name:=BarName, Position:=msoBarBottom)
tbar.Visible = True
For k = 1 To ListNum
On Error Resume Next
AddButton BarIndex, k, BarName
Next
End Sub
Public Sub AddButton(BarIndex, BtnIndex, BarName)
Dim Btn As CommandBarButton
ii = BarIndex * ListNum + BtnIndex
ButtonName = "按钮" & ii
Set Btn = Application.CommandB......
用VBA列出excel的所有按钮(2006-05-29 11:50:00)
摘要：新建一个EXCEL文件，按“Alt”+"F11"，在出现的树状菜单中点击“ThisWorkBook”，在弹出的空白窗口中输入以下代码：
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("ttt").Delete
End Sub
Private Sub Workbook_Open()
Set cbr = Application.CommandBars.Add(Name:="ttt", Position:=msoBarTop, Temporary:=True)
cbr.Visible = True
For k = 1 To 4000
On Error Resume Next
cbr.Controls.Add ID:=k
Next
On Error GoTo 0
End 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, butt9
Dim butt10, butt11, butt12, butt13, butt14, butt15, butt16, butt17, butt18, butt19
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("菜单1").Delete
Application.CommandBars("菜单2").Delete
Application.CommandBars("菜单3").Delete
Application.CommandBars("菜单4").Delete
Application.CommandBars("菜单5").Delete
Application.CommandBars("菜单6").Delete
Application.CommandBars("菜单7").Delete
Application.CommandBars("菜单8").Delete
Application.CommandBars("菜单9").Delete
Application.CommandBars("菜单10").Delete
Application.CommandBars("菜单11").Delete
Application.CommandBars("菜单12").Delete
End Sub
Private Sub Workbook_Open()
Set tbar1 = Application.CommandBars.Add(Name:="菜单1", Position:=msoBarBottom)
Set tbar2 = Application.CommandBars.Add(Name:="菜单2", Position:=msoBarB......
在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)......