如何在EXCEL的VBA中如何创建一个新的工程

ALT+F11

或者右键工作表标签

点查看代码

或者

点

工具-宏-visual

basic

编辑器

进入以后插入一个模块,如果你有别人写好的代码,直接复制进去把相关工作表名或地址改下就行

.然后在工作表中绘制一个图形或按钮,指定你复制的代码的宏名就行了,点击就可以运行了

5.添加宏到工具条

CATIA工具条是具有一定功能的图标按钮组合，一般停靠在用户窗口周围或浮动在界面上。用户可以通过工具条快捷调用特定 *** 作，使用起来比较方便。

CATIA提供了自定义工具条机制，可以把CATIA宏或VBA项目添加到指定模块的工具条中，供用户随时的调用。假设需要将前面讲到的创建正弦曲线的宏文件在创成式曲面设计（GSD）模块下添加工具条，其 *** 作步骤如下：

（1）打开“定制…”菜单

先把当前CATIA环境切换到创成式曲面设计(创建完成后的工具条在当前模块中出现)，然后点击“工具->定制…”（或“工具->自定义…”，不同版本汉化时有差异），d出对话框如下图：

选择“命令”选项卡，在左侧列表“类别”中选择“宏”，此时右侧可见当前宏库中的宏文件。我们选择sincurve2.catvbs，在“显示属性…”中为此命令选择图标并设定快捷键。

选择“工具栏”选项卡，单击右侧“新建…”按钮，在d出的对话框中输入工具栏名称，如“正弦曲线”，则左侧列表中出现正弦曲线条目。

点击“添加命令…”按钮，在命令列表中选择sincurve2.catvbs， *** 作完成，在CATIA窗口中出现新工具条。点击此工具条，则系统开始执行sinecurve2.vbs，完成正弦曲线的创建。

'在工程中引用Microsoft ActiveX Data Object 2.6或者更高的版本

Dim db As New ADODB.Connection '声明数据库对像

Dim rs As New ADODB.Recordset  '声明表对像

Dim mstream As ADODB.Stream    '声明流对像(好像也叫二进制对像)

Private Sub 登录数据库_Click()             '打开数据库

On Error GoTo ErrHandle                    '错误处理

db.Open "Provider=Microsoft.Jet.OLEDB.4.0Data Source=F:\巨浪网络\数据库练习3\Data.mdb" '无密码访问

'db.Open "Provider=Microsoft.Jet.OLEDB.4.0Data Source=F:\巨浪网络\数据库练习3\Data2.mdbJet OLEDB:database password=123456" '有密码访问123456为数据库密码

rs.Open "Select * From 学生名单 ", db, 1, 3

'rs.Open "Select * From 学生名单 ", db, 1, A 'A=1表示读取数据；A=3表示新增、修改或删除数据

ErrHandle:                                 '错误处理

Select Case Err.Number

Case -2147217843

MsgBox "数据库密码错误，请从新输入！", vbInformation, "您好"

End Select

If rs.State = adStateOpen Then

'AdStateClosed指rs对象是关闭的

'AdStateOpen指rs对象是打开的

'AdStateConnectingrs指rs对象正在连接

'AdStateExecutingrs指rs对象正在执行命令

'AdStateFetchingrs指rs对象的行正在被读取

MsgBox "数据库已成功打开！", vbInformation, "您好"

End If

End Sub

Private Sub Form_Unload(Cancel As Integer) '关闭数据库

rs.Close '关闭表

db.Close '关闭数据库

End Sub

Private Sub Command2_Click()               '指向下一条记录

If rs.EOF = True Then          '如果是最后一条记录(true为是，False为不是)

MsgBox "这已是最后一条记录！", vbInformation, "您好"

Else                           '如果不是最后一条记录

rs.MoveNext                    '指向下一条

End If

End Sub

Private Sub Command3_Click()               '指向上一条记录

If rs.BOF = True Then          '如果是最前一条记录(true为是，False为不是)

MsgBox "这已是最前一条记录！", vbInformation, "您好"

Else                           '如果不是最前一条记录

rs.MovePrevious                '指向上一条

End If

End Sub

Private Sub Command4_Click()               '指向第一条记录

rs.MoveFirst                   '指向第一条

End Sub

Private Sub Command5_Click()               '指向最后一条记录

rs.MoveLast                    '指向最后一条

End Sub

Private Sub Command6_Click()               '向下移动1行

rs.Move 1                      '向下移动1行

End Sub

Private Sub Command7_Click()               '添加记录

rs.AddNew

rs.Fields(0) = "666"           '对应编号列

rs.Fields(1) = "小牛"          '对应姓名列

rs.Fields(2) = "23"            '对应年龄列

rs.Update

End Sub

Private Sub Command8_Click()               '更新记录(更新的是当前行)

rs("姓名") = "小大牛"          '对应姓名列

rs("年龄") = "23"              '对应年龄列

rs.Update

End Sub

Private Sub Command9_Click()               '删除记录(删除的是当前行)

rs.Delete (0)

End Sub

Private Sub Command10_Click()              '查找记录

rs.Find "编号='168'"           '168为查找条件

If rs.EOF = False Then

MsgBox "已找到符合条件记录！且已移动到该条记录下！", vbInformation, "您好"

Else

MsgBox "对不起，啥也没找到！", vbInformation, "您好"

End If

End Sub

Private Sub Command12_Click()              '更新文件(更新的是当前行)

Set mstream = New ADODB.Stream

mstream.Type = adTypeBinary

mstream.Open

mstream.LoadFromFile "c:\美女图片.jpg"

rs.Fields("二进制").Value = mstream.Read '对应二进制列

rs.Update

End Sub

Private Sub Command13_Click()              '保存文件

Set mstream = New ADODB.Stream

mstream.Type = adTypeBinary

mstream.Open

mstream.LoadFromFile "c:\1.exe"

rs.AddNew

rs.Fields(0) = "88"                      '对应编号列

rs.Fields(1) = "小"                      '对应姓名列

rs.Fields(2) = "20"                      '对应年龄列

rs.Fields("二进制").Value = mstream.Read '对应二进制列

rs.Update

End Sub

Private Sub Command14_Click()              '导出文件

Set mstream = New ADODB.Stream

mstream.Type = adTypeBinary

mstream.Open

mstream.Position = 0

mstream.Write rs.Fields("二进制").Value    '对应二进制列

mstream.SaveToFile "c:\2.exe", adSaveCreateOverWrite

End Sub

Private Sub Command1_Click()               '显示记录

'代码出处：http://blog.sina.com.cn/s/blog_6d5459990100yr2r.html

Text1.Text = rs.Fields("编号") '将编号这个字段第一行数据(默认是第一行数据)赋值给Text1

Text2.Text = rs.Fields("姓名") '将姓名这个字段第一行数据(默认是第一行数据)赋值给Text2

Text3.Text = rs.Fields("年龄") '将年龄这个字段第一行数据(默认是第一行数据)赋值给Text3

Text4.Text = rs.Fields.Count   '数据表总字段数(也就是数据表总列数)

Text5.Text = rs.RecordCount    '数据表记录总数(也就是数据表总行数)

Text6.Text = rs(0).Name        '第1个字段的名称(也就是数据表第1列列头的文字)

Text7.Text = rs(0)             '第1个字段的数据(也就是数据表第1列列头下面的第一行文字)

Text8.Text = rs("姓名")        '指定字段数据(和rs.Fields类似)

End Sub

'==============================修改数据库密码(建议每次退出程序时执行一次)==============================

'工程-引用Microsoft Jet and Replication Objects Library 2.6 Library

Private Sub Command11_Click()

Dim miJRO As JRO.JetEngine

Set miJRO = New JRO.JetEngine

miJRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0 " & "Data Source=" & "F:\巨浪网络\数据库练习3\Data.mdb" & "Jet OLEDB:Database Password=123", _

                      "Provider=Microsoft.Jet.OLEDB.4.0 " & "Data Source=" & "F:\巨浪网络\数据库练习3\Data0.mdb" & "Jet OLEDB:Database Password=abc"     '123为修改前的密码 abc为修改后的密码

End Sub

'======================================================================================================

---