Office中国论坛/Access中国论坛 › Access中国门户旧版 ›Access源码› 杂项/其它 › 查看内容

access的一个如何建工具栏（toolbar）的例子，中文注解。

2002-5-8 02:08| 发布者: admin| 查看: 821| 评论: 27|原作者: MsAccess|来自: www.office-cn.net

摘要: 文件下载

'****************************************************************

' 本过程建立一新工具栏

'****************************************************************

Sub AddNewCB()

Dim CBar As CommandBar, CBarCtl As CommandBarControl

On Error GoTo AddNewCB_Err

' 新建一浮动工具栏,并且可见.

Set CBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _

msoBarFloating)

CBar.Visible = True

' 建立一具有文字的按钮并设置其属性.

Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)

With CBarCtl

.Caption = "按钮"

.Style = msoButtonCaption

.TooltipText = "按钮显示信息框"

.OnAction = "=MsgBox(""你按了工具栏一按钮!"")"

End With

' 建立一具有图标的按钮并设置其属性.

Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)

With CBarCtl

.FaceId = 1000

.Caption = "切换按钮"

.TooltipText = "切换第一个按钮(可见/隐藏)"

.OnAction = "=ToggleButton()"

End With

' 建立组合框控件并设置相应属性.

Set CBarCtl = CBar.Controls.Add(msoControlComboBox)

With CBarCtl

.Caption = "下拉菜单"

.Width = 100

.AddItem "新建按钮", 1

.AddItem "移去按钮", 2

.DropDownWidth = 100

.OnAction = "=AddRemoveButton()"

End With

Exit Sub

AddNewCB_Err:

If Err.Number = 5 Then '存在则删除

For Each CBar In Application.CommandBars

If CBar.Name = "Sample Toolbar" Then

CBar.Delete

Resume

End If

Exit Sub

End If

MsgBox "Error " & Err.Number & vbCr & Err.Description

Exit Sub

End Sub

'****************************************************************

' 本过程为工具栏上的按钮调用.

' 它使另一按钮在可见和隐藏间切换.

'****************************************************************

Function ToggleButton()

Dim CBButton As CommandBarControl

On Error GoTo ToggleButton_Err

Set CBButton = CommandBars("Sample Toolbar").Controls(1)

CBButton.Visible = Not CBButton.Visible

Exit Function

ToggleButton_Err:

MsgBox "Error " & Err.Number & vbCr & Err.Description

Exit Function

End Function

'****************************************************************

'本过程为工具栏上的组合框所调用

'它用于添加和删除按钮

'****************************************************************

Function AddRemoveButton()

Dim CBar As CommandBar, CBCombo As CommandBarComboBox

Dim CBNewButton As CommandBarButton

On Error GoTo AddRemoveButton_Err

Set CBar = CommandBars("Sample Toolbar")

Set CBCombo = CBar.Controls(3)

Select Case CBCombo.ListIndex

'如果按了新建按钮, 则建立一按钮

Case 1

Set CBNewButton = CBar.Controls.Add(Type:=msoControlButton)

With CBNewButton

.Caption = "新按钮"

.Style = msoButtonCaption

.BeginGroup = True

.Tag = "新建的按钮"

.OnAction = "=MsgBox(""这可是新鲜出炉的按钮!"")"

End With

' 移去如果有新按钮,找到并移去.

Case 2

Set CBNewButton = CBar.FindControl(Tag:="新建的按钮")

CBNewButton.Delete

Case Else

' 如果用户自行输入(不在列表)

MsgBox "你输入的内容为:" & CBCombo.Text, vbInformation, "Ms Access"

End Select

Exit Function

AddRemoveButton_Err:

' 如果按钮不存在.

If Err.Number = 91 Then

MsgBox "无法移去不存在的按钮!"

Exit Function

Else

MsgBox "错误 " & Err.Number & vbCr & Err.Description

Exit Function

End If

End Function

示例文件下载

收藏分享邀请

上一篇：micorsoft DAP 技术论文

发表评论

帐号		自动登录	找回密码
密码			注册

access的一个如何建工具栏（toolbar）的例子，中文注解。

最新评论

相关分类