这是最近修改后的代码:
Public i, si, ei As Integer
Dim mybar As CommandBar
Dim mybutton1 As CommandBarButton
Sub sAdd()
Application.ScreenUpdating = False
On Error Resume Next
sDel
Set mybar = Application.CommandBars.Add(Name:="我的工具栏", Position:=msoBarFloating) '创建我的工具栏
With mybar
.Visible = False '设置我的工具栏不可见
.Enabled = True '设置我的工具栏可用
.Left = 200
.Top = 150
For i = si To ei
Set mybutton1 = Application.CommandBars("我的工具栏").Controls.Add(Type:=msoControlButton, Temporary:=True) '在工具栏中新建按钮
With mybutton1
.FaceId = i '按钮图标ID
.Caption = "FaceID=" & i
.Style = msoButtonIcon
.OnAction = "useinsent"
.Visible = True
End With
Next i
.Width = 489
.Visible = True '设置我的工具栏可见
End With
Application.ScreenUpdating = True
End Sub
Sub sDel()
On Error Resume Next
Application.CommandBars("我的工具栏").Delete
End Sub
Sub sDelAll()
On Error Resume Next
Application.CommandBars("图标工具启动").Delete
Application.CommandBars("我的工具栏").Delete
End Sub
Sub useinsent()
On Error Resume Next
Application.CommandBars.ActionControl.CopyFace
If Application.Name = "Microsoft Word" Then
Selection.GoToPrevious what:=wdGoToEndnote '定位插入点为当前光标处
Selection.Paste
Else
activesheet.Paste
End If
End Sub
Sub myAdd()
si = 1
ei = 200
On Error Resume Next
Application.CommandBars("图标工具启动").Delete
Application.CommandBars("我的工具栏").Delete
Set mybar = Application.CommandBars.Add(Name:="图标工具启动", Position:=msoBarTop) '创建我的工具栏
With mybar
.Visible = True '设置我的工具栏可见
.Enabled = True '设置我的工具栏可用
End With
Set mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True) '在工具栏中新建按钮
With mybutton1
.FaceId = 178 '按钮图标ID
.Caption = "显示图标待选框"
.Style = msoButtonIcon
.OnAction = "sAdd"
.Visible = True
End With
Set mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True) '在工具栏中新建按钮
With mybutton1
.FaceId = 41 '按钮图标ID
.Caption = "向前翻"
.Style = msoButtonIcon
.OnAction = "i_changeLeft"
.Visible = True
End With
Set mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True) '在工具栏中新建按钮
With mybutton1
.FaceId = 39 '按钮图标ID
.Caption = "向后翻"
.Style = msoButtonIcon
.OnAction = "i_changeRight"
.Visible = True
End With
Set mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True) '在工具栏中新建按钮
With mybutton1
.FaceId = 330 '按钮图标ID
.Caption = "删除插入图标工具"
.Style = msoButtonIcon
.OnAction = "sDelAll"
.Visible = True
End With
End Sub
Sub i_changeLeft()
On Error Resume Next
If ei - 200 <= 0 Then
si = 1
ei = 200
Else
si = si - 200
ei = ei - 200
End If
sAdd
End Sub
Sub i_changeRight()
On Error Resume Next
si = ei
ei = ei + 200
sAdd
End Sub
可用于WORD 或excel,在word 中可在当前光标处,在excel中可在活动单元格中插入我的工具栏中的图标。
将代码复制到word或excel 的模块中,运行myadd,点击新建工具栏上的显示图标待选框按钮(可显示我的工具栏)
相关附件:
dmvRrJNg.rar
(11.69 KB, 下载次数: 689)
[此贴子已经被作者于2004-9-23 9:04:47编辑过] |