求救______通过宏添加自定义按钮及按钮功能,各位微软专家及OFFICE开发高手来帮帮忙啊!
想请教各位OFFICE开发高手,怎么样才能实现题目的功能?前提是在一个宏里面实现.
在添加按钮时,CommandBars("自定义工具栏").Controls.Add( TYPE,ID,PARAMETER,BEFORE,TEMPORARY)这几个参数分别是什么意思，有什么作用呢?按钮的功能应该是通过OnAction属性实现的吧。我在MSDN上看过，可以是调用另一个宏，也可以是自己写的代码表达式，但是例子只有一个调用宏的。急啊，望各位来帮帮小弟啦。。。。。。。。。。
问题点数：100、回复次数：12Top
1 楼fjfzman（哎哎）回复于 2002-10-13 11:20:56 得分 20
TYPE, 按钮类型;
ID:是内置按钮图标的号码;
EMPORARY:是决定你所添加的按钮是临时还永久的,如果为TRUE,则你所加的按钮只对本文件有效,如果为FALSE,调用其他文件时也会出现这个按钮.
比如你的按钮名为:
cbn1
你的代码过程名为TEST
如:
sub teszt()
msgbox "ok"
end sub
按钮调用过程则为:
sub cbn1_click()
test
end sub
Top
2 楼yuan320（球星）回复于 2002-10-13 12:37:08 得分 5
你可以试试用 宏命令RunMacro来调用另一个宏命令
Top
3 楼Wolfyee（Finance）回复于 2002-10-13 16:25:56 得分 0
问题是我不能事先给WORD加入一个按钮的宏，我只能通过执行一段代码，相当于让WORD执行一段宏实现所有功能。Top
4 楼kamahuma（kamahuma）回复于 2002-10-15 21:40:37 得分 5
我也在为这个方面的问题发愁，我想为Excell添加一组个下拉菜单，我最近查了很多资料，似乎Vba不合适，不知是不是应该用VB去做？
如果你有了答案希望能通知我一声。
我要解决了这个问题也会通知你的。Top
5 楼nealbzdn（）回复于 2002-10-16 10:51:34 得分 5
用add-in功能
如果用宏也很方便啊，编写代码自己添加按钮呗Top
6 楼Wolfyee（Finance）回复于 2002-10-17 15:04:16 得分 0
To nealbzdn()
能不能给个简单的例子呢? ADD-IN可以一次实现定义按钮和按钮的功能吗?按钮的功能可是要自定义的哦Top
7 楼AndrewChou（夸父追日）回复于 2002-10-17 21:33:58 得分 5
ADD-IN当原可以。我最近开发了一个有add in的按钮和菜单程序。如果用宏用户禁用后就不能用,我的add-in只要启动office 就可用，就想photoshop的外挂程序Top
8 楼Wolfyee（Finance）回复于 2002-10-18 08:42:04 得分 0
各位能不能提供一下简单的例子让小弟参考一下,谢谢啦....Top
9 楼cureall（白）回复于 2002-10-18 09:59:37 得分 30
提问的朋友，你的编程环境是Word的宏编辑还是编程语言呢？第一段你说“在一个宏里面实现”，后面说到“我不能事先给WORD加入一个按钮的宏”；
所以我不太明白问题所指，是不是只要实现“添加按钮”+“按钮之后执行某段自定义代码”就行？题目上有“通过宏”，我想下面这个例子可能是你想要的，不然用VB等语言写addin，可就不是十行能说明白的啦。
以下宏先运行一次，会建立相应按钮；每次按按钮，会执行自编代码;
在Word中创建宏Macro_TestCommandBar，内容如下：
Sub Macro_TestCommandBar()
' Macro_TestCommandBar() Macro
' 宏在 2002-10-12 由 cureall 录制
' 若第一次运行，没有添加按钮，则添加按钮；否则运行功能代码段
Dim mybar As CommandBar
Dim mybutton As CommandBarButton
Set mybutton = CommandBars.FindControl(Type:=msoControlButton, Tag:="我的按钮")
If mybutton Is Nothing Then
'添加按钮
Set mybar = CommandBars.Add(Name:="我的工具条", Position:=msoBarTop)
mybar.Visible = True
Set mybutton = mybar.Controls.Add(Type:=msoControlButton)
mybutton.Caption = "我的按钮"
mybutton.Style = msoButtonCaption
mybutton.Tag = "我的按钮"
mybutton.OnAction = "Macro_TestCommandBar" '与此宏名相同
Else
'执行代码
MsgBox "让我们即刻开始工作"
End If
End Sub
Top
10 楼Wolfyee（Finance）回复于 2002-10-20 17:47:01 得分 0
To 白：
我的编程环境是VS.NET下，在ASPNET中用VBNET写后台代码。所以不知道如何在这样的环境下给WORD添加一段宏。Top
11 楼fengqiang（take）回复于 2002-10-21 19:24:45 得分 30
Sub AddToMenuBar()
Dim X(1 To 12, 1 To 2) As Variant
Dim y(1 To 7, 1 To 3) As Variant
Dim u(1 To 11, 1 To 2) As Variant
Dim v(1 To 9, 1 To 3) As Variant
Dim i As Integer
Dim j As Integer
Dim flag1 As Integer
Dim flag2 As Integer
i = j = 1
flag1 = 0
flag2 = 0
X(1, 1) = "科室"
X(1, 2) = "fq.xla!科室输入"
X(2, 1) = "姓名"
X(2, 2) = "fq.xla!姓名输入"
X(3, 1) = "系列"
X(3, 2) = "fq.xla!产品系列"
X(4, 1) = "产品"
X(4, 2) = "fq.xla!产品名称"
X(5, 1) = "单价"
X(5, 2) = "fq.xla!单价录入"
X(6, 1) = "效率"
X(6, 2) = "fq.xla!生产效率录入"
X(7, 1) = "不变价"
X(7, 2) = "fq.xla!不变价输入"
X(8, 1) = "刷新"
X(8, 2) = "fq.xla!kaishi"
X(9, 1) = "保存"
X(9, 2) = "fq.xla!luru"
X(10, 1) = "录入"
X(10, 2) = "fq.xla!设置"
X(11, 1) = "撤消"
X(11, 2) = "fq.xla!pop"
X(12, 1) = "80%"
X(12, 2) = "fq.xla!zoom1"
y(1, 1) = "选择科室"
y(1, 2) = "fq.xla!xingming"
y(1, 3) = 80
y(2, 1) = "选择姓名"
y(2, 2) = ""
y(2, 3) = 60
y(3, 1) = "选择产品系列"
y(3, 2) = "fq.xla!chanpingmingcheng"
y(3, 3) = 100
y(4, 1) = "选择产品名称"
y(4, 2) = "fq.xla!产品查询"
y(4, 3) = 120
y(5, 1) = "选择单价录入"
y(5, 2) = ""
y(5, 3) = 50
y(6, 1) = "选择生产效率录入"
y(6, 2) = ""
y(6, 3) = 50
y(7, 1) = "选择不变价录入"
y(7, 2) = ""
y(7, 3) = 50
u(1, 1) = "科室"
u(1, 2) = "fq.xla!美国科室"
u(2, 1) = "姓名"
u(2, 2) = "fq.xla!美国姓名"
u(3, 1) = "系列"
u(3, 2) = "fq.xla!美国系列"
u(4, 1) = "产品"
u(4, 2) = "fq.xla!美国产品"
u(5, 1) = "价格"
u(5, 2) = "fq.xla!美国价格"
u(6, 1) = "零件"
u(6, 2) = "fq.xla!美国零件"
u(7, 1) = "价格"
u(7, 2) = "fq.xla!美国零件价格"
u(8, 1) = "工序"
u(8, 2) = "fq.xla!美国工序"
u(9, 1) = "班产"
u(9, 2) = "fq.xla!美国班产"
u(10, 1) = "刷新"
u(10, 2) = "fq.xla!美国刷新"
u(11, 1) = "保存"
u(11, 2) = "fq.xla!美国保存"
v(1, 1) = "选择科室"
v(1, 2) = "fq.xla!美国姓名查询"
v(1, 3) = 80
v(2, 1) = "选择姓名"
v(2, 2) = ""
v(2, 3) = 60
v(3, 1) = "选择系列"
v(3, 2) = "fq.xla!美国产品查询"
v(3, 3) = 60
v(4, 1) = "选择产品"
v(4, 2) = "fq.xla!美国产品价格查询"
v(4, 3) = 120
v(5, 1) = "选择价格"
v(5, 2) = ""
v(5, 3) = 60
v(6, 1) = "选择零件"
v(6, 2) = "fq.xla!美国零件查询"
v(6, 3) = 120
v(7, 1) = "选择零件价格"
v(7, 2) = ""
v(7, 3) = 60
v(8, 1) = "选择工序"
v(8, 2) = "fq.xla!美国工序查询"
v(8, 3) = 100
v(9, 1) = "选择班产/计件价"
v(9, 2) = ""
v(9, 3) = 60
For Each cbar In CommandBars
If (cbar.Name = "Custom") Then
flag = 1
Else
If (cbar.Name = "Custom2") Then
flag2 = 1
End If
End If
Next
If (flag1 = 0) Then
Set cbar1 = CommandBars.Add(Name:="Custom", Position:=msoBarTop)
cbar1.Visible = False
For i = 1 To 7
Set myControl1 = Application.CommandBars("Custom").Controls.Add(Type:=msoControlButton, Id:=2950)
With myControl1
.Caption = X(i, 1)
.Style = msoButtonCaption
.OnAction = X(i, 2)
End With
Set myControl2 = Application.CommandBars("Custom").Controls.Add(Type:=msoControlComboBox, Id:=1)
With myControl2
.Width = y(i, 3)
.DropDownLines = 15
.DropDownWidth = y(i, 3)
.ListHeaderCount = 0
.OnAction = y(i, 2)
.Caption = y(i, 1)
End With
Next i
'For i = 8 To 11
For i = 9 To 12
Set myControl1 = Application.CommandBars("Custom").Controls.Add(Type:=msoControlButton, Id:=2950)
With myControl1
.Caption = X(i, 1)
.Style = msoButtonCaption
.OnAction = X(i, 2)
End With
Next i
End If
For Each ctl In CommandBars("Standard").Controls
If (ctl.Caption = "80%") Then
b = 0
Exit For
Else
b = 1
End If
Next ctl
If (b) Then
Set myControl1 = Application.CommandBars("Standard").Controls.Add(Type:=msoControlButton, Id:=2950)
With myControl1
.Caption = "80%"
.Style = msoButtonCaption
.OnAction = "fq.xla!bili"
End With
End If
cbar1.Visible = True
If (flag2 = 0) Then
Set cbar1 = CommandBars.Add(Name:="Custom2", Position:=msoBarTop)
cbar1.Visible = False
For j = 1 To 9
Set myControl1 = Application.CommandBars("Custom2").Controls.Add(Type:=msoControlButton, Id:=2950)
With myControl1
.Caption = u(j, 1)
.Style = msoButtonCaption
.OnAction = u(j, 2)
End With
Set myControl2 = Application.CommandBars("Custom2").Controls.Add(Type:=msoControlComboBox, Id:=1)
With myControl2
.Width = v(j, 3)
.DropDownLines = 15
.DropDownWidth = v(j, 3)
.ListHeaderCount = 0
.OnAction = v(j, 2)
.Caption = v(j, 1)
End With
Next j
'For j = 10 To 11
For j = 11 To 11
Set myControl1 = Application.CommandBars("Custom2").Controls.Add(Type:=msoControlButton, Id:=2950)
With myControl1
.Caption = u(j, 1)
.Style = msoButtonCaption
.OnAction = u(j, 2)
End With
Next j
End If
cbar1.Visible = True
End Sub
Sub Auto_Open()
'bili
AddToMenuBar
kaishi
美国刷新
'myzoom
End Sub
Sub 设置()
Dim RetVal
RetVal = Shell("C:\Program Files\Common Files\Borland Shared\BDE\Project1.exe", 3)
End Sub
Sub Auto_Close()
Application.CommandBars("Custom").Delete
Application.CommandBars("Custom2").Delete
End SubTop
12 楼fengqiang（take）回复于 2002-10-21 19:26:24 得分 0
Dim wrkNewODBC As Workspace
Dim db As Database
Dim rs1 As Recordset
Dim i As String
Sub kaishi()
Set fqbar = CommandBars("Custom")
Set fqcontrol1 = fqbar.Controls(2)
Set fqcontrol3 = fqbar.Controls(6)
Set fqcontrol2 = fqbar.Controls(4)
Set fqcontrol4 = fqbar.Controls(8)
Set fqcontrol5 = fqbar.Controls(10)
Set fqcontrol6 = fqbar.Controls(12)
fqcontrol1.Clear
fqcontrol2.Clear
fqcontrol3.Clear
fqcontrol4.Clear
fqcontrol5.Clear
fqcontrol6.Clear
Set wrkNewODBC = CreateWorkspace("NewODBCWorkspace", "", "", dbUseODBC)
Set db = wrkNewODBC.OpenConnection("Connection1", dbDriverNoPrompt, , _
"ODBC;DATABASE=EMI003;UID=sa;PWD=;DSN=server")
Set rs1 = db.OpenRecordset("select * from 科室 ", dbOpenSnapshot)
If (rs1.RecordCount > 0) Then
With rs1
.MoveFirst
Do While True
fqcontrol1.AddItem rs1.Fields(0).Value
rs1.MoveNext
If .EOF Then Exit Do
Loop
End With
rs1.Close
fqcontrol3.Clear
Set rs1 = db.OpenRecordset("select 产品系列 from 产品系列 ", dbOpenSnapshot)
With rs1
.MoveFirst
Do While True
fqcontrol3.AddItem rs1.Fields(0).Value
rs1.MoveNext
If .EOF Then Exit Do
Loop
End With
End If
rs1.Close
db.Close
wrkNewODBC.Close
' Windows("fq.xls").Close
End Sub
Sub xingming()
Set fqbar = CommandBars("Custom")
Set fqcontrol1 = fqbar.Controls(2)
Set fqcontrol2 = fqbar.Controls(4)
fqcontrol2.Clear
Set wrkNewODBC = CreateWorkspace("NewODBCWorkspace", "", "", dbUseODBC)
Set db = wrkNewODBC.OpenConnection("Connection1", dbDriverNoPrompt, , _
"ODBC;DATABASE=EMI003;UID=sa;PWD=;DSN=server")
Set rs1 = db.OpenRecordset("select xingming from xingming where 科室='" & fqcontrol1.Text & "'", dbOpenSnapshot)
If (rs1.RecordCount > 0) Then
With rs1
.MoveFirst
Do While True
fqcontrol2.AddItem rs1.Fields(0).Value
rs1.MoveNext
If .EOF Then Exit Do
Loop
End With
End If
rs1.Close
db.Close
wrkNewODBC.Close
' Windows("fq.xls").Close
End Sub
Sub chanpingmingcheng()
Set fqbar = CommandBars("Custom")
Set fqcontrol1 = fqbar.Controls(6)
Set fqcontrol2 = fqbar.Controls(8)
fqcontrol2.Clear
Set wrkNewODBC = CreateWorkspace("NewODBCWorkspace", "", "", dbUseODBC)
Set db = wrkNewODBC.OpenConnection("Connection1", dbDriverNoPrompt, , _
"ODBC;DATABASE=EMI003;UID=sa;PWD=;DSN=server")
Set rs1 = db.OpenRecordset("select chanpingmingchen from kaohezhiliao where 系列='" & fqcontrol1.Text & "'", dbOpenSnapshot)
If (rs1.RecordCount > 0) Then
With rs1
.MoveFirst
Do While True
fqcontrol2.AddItem rs1.Fields(0).Value
rs1.MoveNext
If .EOF Then Exit Do
Loop
End With
End If
rs1.Close
db.Close
wrkNewODBC.Close
' Windows("fq.xls").Close
End Sub
Sub luru()
If (Windows.Count <> 0) Then
push
Set fqbar = CommandBars("Custom")
Set fqcontrol1 = fqbar.Controls(2)
Set fqcontrol2 = fqbar.Controls(4)
Set fqcontrol3 = fqbar.Controls(6)
Set fqcontrol4 = fqbar.Controls(8)
Set wrkNewODBC = CreateWorkspace("NewODBCWorkspace", "", "", dbUseODBC)
Set db = wrkNewODBC.OpenConnection("Connection1", dbDriverNoPrompt, , _
"ODBC;DATABASE=EMI003;UID=sa;PWD=;DSN=server")
Set rs1 = db.OpenRecordset("select chanpingmingchen,danjia,zuidixiaolv,chongcimeifen from kaohezhiliao where chanpingmingchen='" & fqcontrol4.Text & "'", dbOpenSnapshot)
If (rs1.RecordCount > 0) Then
If (i <> fqcontrol2.Text) Then
ActiveCell.FormulaR1C1 = fqcontrol2.Text 'xingming
End If
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Value = Trim(rs1.Fields(0).Value) 'chanpingmingchen
ActiveCell.Offset(rowOffset:=0, columnOffset:=2).Value = "" 'kong
ActiveCell.Offset(rowOffset:=0, columnOffset:=3).Value = rs1.Fields(1).Value 'danjia
ActiveCell.Offset(rowOffset:=0, columnOffset:=4).Value = "" 'kong
ActiveCell.Offset(rowOffset:=0, columnOffset:=5).Value = rs1.Fields(2).Value 'zuidixiaolv
ActiveCell.Offset(rowOffset:=0, columnOffset:=6).Value = "" 'kong
ActiveCell.Offset(rowOffset:=0, columnOffset:=7).Value = rs1.Fields(3).Value 'chongcimeifen
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
i = fqcontrol2.Text
'UserForm1.Top = ActiveCell.Offset(rowOffset:=0, columnOffset:=0).Top
'UserForm1.Left = ActiveCell.Offset(rowOffset:=0, columnOffset:=0).Left
Else
MsgBox "没有记录"
End If
rs1.Close
db.Close
wrkNewODBC.Close
'Windows("fq.xls").Close
Else
End If
End Sub
Sub 产品查询()
Set fqbar = CommandBars("Custom")
Set fqcontrol1 = fqbar.Controls(8)
Set fqcontrol2 = fqbar.Controls(10)
Set fqcontrol3 = fqbar.Controls(12)
Set fqcontrol4 = fqbar.Controls(14)
fqcontrol2.Clear
fqcontrol3.Clear
Set wrkNewODBC = CreateWorkspace("NewODBCWorkspace", "", "", dbUseODBC)
Set db = wrkNewODBC.OpenConnection("Connection1", dbDriverNoPrompt, , _
"ODBC;DATABASE=EMI003;UID=sa;PWD=;DSN=server")
Set rs1 = db.OpenRecordset("select danjia,生产效率,产品不变价格 from kaohezhiliao where chanpingmingchen='" & fqcontrol1.Text & "'", dbOpenSnapshot)
If (rs1.RecordCount > 0) Then
With rs1
.MoveFirst
fqcontrol2.Text = Trim(rs1.Fields(0).Value)
fqcontrol3.Text = Trim(rs1.Fields(1).Value)
fqcontrol4.Text = Trim(rs1.Fields(2).Value)
End With
End If
rs1.Close
db.Close
wrkNewODBC.Close
End Sub
Top
