提取office程序中的按钮图标及其ID

在word中运行以下代码：

Dim sid As IntegerSub face()

With Application.CommandBars("Standard").Controls(1)sid = .FaceIdFor i = 1 To 100.FaceId = i.CopyFaceSelection.TypeText Text:=iSelection.PasteNext i.FaceId = sidEnd WithEnd Sub

想看更多的图标及其Id，只要将for 语句中的100改大一点的数

如图：document.body.clientWidth*0.5) {this.resized=true;this.width=document.body.clientWidth*0.5;this.style.cursor='pointer';} else {this.onclick=null}" alt="" />

附件

oFEJGhho.jpg(65.34 KB)

2004-9-16 09:57

提取office程序中的按钮图标及其ID

MItQrU9H.zip (15.96 KB)

MItQrU9H.zip (15.96 KB)
提取office程序中的按钮图标及其ID
下载次数: 159

2004-9-16 11:04

不错，鼓励一下。

如果能更进一步，请参此附件程序。

这是最近修改后的代码：

Public i, si, ei As IntegerDim mybar As CommandBarDim mybutton1 As CommandBarButton

Sub sAdd()Application.ScreenUpdating = FalseOn Error Resume NextsDelSet mybar = Application.CommandBars.Add(Name:="我的工具栏", Position:=msoBarFloating)'创建我的工具栏With mybar.Visible = False'设置我的工具栏不可见.Enabled = True'设置我的工具栏可用.Left = 200.Top = 150

For i = si To eiSet mybutton1 = Application.CommandBars("我的工具栏").Controls.Add(Type:=msoControlButton, Temporary:=True)'在工具栏中新建按钮With mybutton1.FaceId = i'按钮图标ID.Caption = "FaceID＝" & i.Style = msoButtonIcon.OnAction = "useinsent".Visible = TrueEnd WithNext i.Width = 489.Visible = True'设置我的工具栏可见End WithApplication.ScreenUpdating = TrueEnd SubSub sDel()On Error Resume NextApplication.CommandBars("我的工具栏").DeleteEnd SubSub sDelAll()On Error Resume NextApplication.CommandBars("图标工具启动").DeleteApplication.CommandBars("我的工具栏").Delete

End SubSub useinsent()On Error Resume NextApplication.CommandBars.ActionControl.CopyFaceIf Application.Name = "Microsoft Word" ThenSelection.GoToPrevious what:=wdGoToEndnote'定位插入点为当前光标处Selection.PasteElseactivesheet.PasteEnd IfEnd Sub

Sub myAdd()si = 1ei = 200On Error Resume NextApplication.CommandBars("图标工具启动").DeleteApplication.CommandBars("我的工具栏").Delete

Set mybar = Application.CommandBars.Add(Name:="图标工具启动", Position:=msoBarTop)'创建我的工具栏With mybar.Visible = True'设置我的工具栏可见.Enabled = True'设置我的工具栏可用

End WithSet mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True)'在工具栏中新建按钮With mybutton1.FaceId = 178'按钮图标ID.Caption = "显示图标待选框".Style = msoButtonIcon.OnAction = "sAdd".Visible = TrueEnd With

Set mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True)'在工具栏中新建按钮With mybutton1.FaceId = 41'按钮图标ID.Caption = "向前翻".Style = msoButtonIcon.OnAction = "i_changeLeft".Visible = TrueEnd WithSet mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True)'在工具栏中新建按钮With mybutton1.FaceId = 39'按钮图标ID.Caption = "向后翻".Style = msoButtonIcon.OnAction = "i_changeRight".Visible = TrueEnd WithSet mybutton1 = Application.CommandBars("图标工具启动").Controls.Add(Type:=msoControlButton, Temporary:=True)'在工具栏中新建按钮With mybutton1.FaceId = 330'按钮图标ID.Caption = "删除插入图标工具".Style = msoButtonIcon.OnAction = "sDelAll".Visible = TrueEnd With

End Sub

Sub i_changeLeft()On Error Resume NextIf ei - 200 <= 0 Thensi = 1ei = 200Elsesi = si - 200ei = ei - 200End IfsAddEnd SubSub i_changeRight()On Error Resume Nextsi = eiei = ei + 200sAddEnd Sub可用于WORD 或excel,在word 中可在当前光标处，在excel中可在活动单元格中插入我的工具栏中的图标。

将代码复制到word或excel 的模块中，运行myadd，点击新建工具栏上的显示图标待选框按钮（可显示我的工具栏）

相关附件：

dmvRrJNg.rar (11.69 KB)

dmvRrJNg.rar (11.69 KB)
下载次数: 107

2004-9-23 09:00

[此贴子已经被作者于2004-9-23 9:04:47编辑过]

To sailorgg:

做得真不错！

纠正一个不足：“Selection.GoToPrevious what:=wdGoToEndnote'定位插入点为当前光标处”

此代码意思应为定位至前一个尾注处（Endnote应为尾注），如果图片格式为嵌入型的话，此代码为省略。否则应加入代码对图片格式进行适当设置.

[此贴子已经被作者于2004-9-26 15:49:22编辑过]

请问版主：正宗的定位光标到当前处的vba 代码如何写？