To Chijianzen：如何将这个Faceids Addin做入VBE工具栏或其右键菜单中？

FENGJUN

如何将这个Faceids Addin做入VBE工具栏或其右键菜单中？

达到象图中的Smart Indent一样方便调用的目的。

http://j-walk.com/ss/excel/files/faceids.exe

taller

结合Chijanzen的VBE例子,给你一个简单的例子

Sub add() With Application.VBE.CommandBars("Code Window").Controls.add .Caption = "myMenu" .OnAction = "" End With End Sub Sub del() Application.VBE.CommandBars("Code Window").Controls("myMenu").Delete End Sub

FENGJUN

To taller:

非常感谢！我将尝试参考上楼代码达成目的。

zyds

楼上真的厉害。

由于最近在做一个有关TREEVIEW的工具，正巧在chijanzen的站点上查到一个相关的例子：G0001。

其中的一段代码在我的机器上运行出错，提示是编译错误，方法和数据成员未找到。

...

Dim NewButton As CommandBarButton

...

Set picPicture = NewButton.Picture

...

查看帮助后发现CommandBarButton没有Picture属性（CommandButton有），

这是运行环境的版本的问题吗？

请楼上的大侠指点。

zyds

所以啊，我也觉得是环境的版本问题。

类似还有Application.CommandBars.ActionControl没有Picture对象/属性

chijanzen

以下是引用zyds在2004-9-24 16:12:00的发言：

楼上真的厉害。

由于最近在做一个有关TREEVIEW的工具，正巧在chijanzen的站点上查到一个相关的例子：G0001。

其中的一段代码在我的机器上运行出错，提示是编译错误，方法和数据成员未找到。

...

Dim NewButton As CommandBarButton

...

Set picPicture = NewButton.Picture

...

查看帮助后发现CommandBarButton没有Picture属性（CommandButton有），

这是运行环境的版本的问题吗？

请楼上的大侠指点。

你好:

IPictureDisp 物件只適用於以下軟體

Microsoft Visual Basic Enterprise Edition for Windows 6.0

Microsoft Visual Basic Professional Edition for Windows 6.0

Microsoft Office Access 2003

Microsoft Access 2002

Microsoft Office Excel 2003

Microsoft Excel 2002

Microsoft Office Word 2003

Microsoft Word 2002

Microsoft Office FrontPage 2003

Microsoft FrontPage 2002

Microsoft Office Outlook 2003

Microsoft Outlook 2002

Microsoft Office PowerPoint 2003

Microsoft PowerPoint 2002

chijanzen

你好:

做了一個範例，請參考

Excel-VBA程式碼範例 @2004 chijanzen

索 引	F0009
主 題	在VBE程式碼視窗("Code Window")功能表中新增控制項
版 本	>= 9.0(Office 2000)
說 明	本範例提供在VBE程式碼視窗("Code Window")功能表中新增 msoControlPopup 及 msoControlButton 兩種Type的控制項
參 考

Private Sub Workbook_BeforeClose(Cancel As Boolean)

RemoveNewMenuItems

End Sub

---

Private Sub Workbook_Open()

AddNewMenuItems

End Sub

Dim CmdDCModule As VBECmdHandler

Dim CmdDCProject As VBECmdHandler

Dim CmdDLModule As VBECmdHandler

Dim CmdDLProject As VBECmdHandler

Dim CmdItem As CommandBarControl

Dim cmdParent As CommandBarControl

Dim Cmd As CommandBarControl

---

Sub AddNewMenuItems()

Dim r As Integer

RemoveNewMenuItems

With Application.VBE.CommandBars("Code Window")

'讓新增的控制項保持在中間位置

r = VBA.Int(.Controls.Count / 2) + 2

Set cmdParent = .Controls.Add(Type:=msoControlPopup, Before:=r)

End With

cmdParent.Caption = "jan Smart"

With cmdParent

'新增移除註解

Set CmdItem = .Controls.Add(Type:=msoControlPopup)

CmdItem.Caption = "DelComment"

'目前模組

Set Cmd = CmdItem.Controls.Add

Cmd.Caption = "This Module"

Cmd.FaceId = 3039

Set CmdDCModule = New VBECmdHandler

Set CmdDCModule.DCEvtModule = Application.VBE.Events.CommandBarEvents(Cmd)

'所有專案模組

Set Cmd = CmdItem.Controls.Add

Cmd.Caption = "This Project"

Cmd.FaceId = 2557

CmdItem.BeginGroup = True

Set CmdDCProject = New VBECmdHandler

Set CmdDCProject.DCEvtProject = Application.VBE.Events.CommandBarEvents(Cmd)

'新增刪除空行

Set CmdItem = .Controls.Add(Type:=msoControlPopup)

CmdItem.Caption = "DelEmptyLine"

'目前模組

Set Cmd = CmdItem.Controls.Add

Cmd.Caption = "This Module"

Cmd.FaceId = 3039

Set CmdDLModule = New VBECmdHandler

Set CmdDLModule.DLEvtModule = Application.VBE.Events.CommandBarEvents(Cmd)

'所有專案模組

Set Cmd = CmdItem.Controls.Add

Cmd.Caption = "This Project"

Cmd.FaceId = 2557

Set CmdDLProject = New VBECmdHandler

Set CmdDLProject.DLEvtProject = Application.VBE.Events.CommandBarEvents(Cmd)

End With

End Sub

---

Sub RemoveNewMenuItems()

On Error Resume Next

With Application.VBE.CommandBars("Code Window")

.Controls("jan Smart").Delete

End With

End Sub

　

Option Explicit

Public WithEvents DCEvtModule As VBIDE.CommandBarEvents

Public WithEvents DCEvtProject As VBIDE.CommandBarEvents

Public WithEvents DLEvtModule As VBIDE.CommandBarEvents

Public WithEvents DLEvtProject As VBIDE.CommandBarEvents

Dim rCount As Integer, Lentemp As Integer, i As Integer

Dim Strtemp As String, ftemp As String

Dim Vbc As VBComponent

---

Private Sub EvtHandler_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)

On Error Resume Next

handled = True

CancelDefault = True

End Sub

---

Private Sub DCEvtModule_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)

'套用目前模組

With Application.VBE.ActiveCodePane.CodeModule

rCount = .CountOfLines

If rCount > 0 Then

For i = rCount To 1 Step -1

Lentemp = Len(.Lines(i, 1)) '判斷是否為空行

If Lentemp > 0 Then

ftemp = InStr(1, .Lines(i, 1), "'") '尋找註解的位置

If ftemp > 0 Then

If ftemp = 1 Then '註解在第一行

Strtemp = ""

.DeleteLines i

Else

'註解符號前一個字元為空格，才能確保是註解符號

If Mid(.Lines(i, 1), ftemp - 1, ftemp - 1) = " " Then

Strtemp = Mid(.Lines(i, 1), 1, ftemp - 1)

.ReplaceLine i, Strtemp '取代字串(清除註解)

End If

End If

End If

　

End If

Next i

End If

End With

End Sub

---

Private Sub DCEvtProject_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)

'套用專案中所有的模組

For Each Vbc In ActiveWorkbook.VBProject.VBComponents

With Vbc.CodeModule

rCount = .CountOfLines

If rCount > 0 Then

For i = rCount To 1 Step -1

Lentemp = Len(.Lines(i, 1)) '判斷是否為空行

If Lentemp > 0 Then

ftemp = InStr(1, .Lines(i, 1), "'") '尋找註解的位置

If ftemp > 0 Then

If ftemp = 1 Then '註解在第一行

Strtemp = ""

.DeleteLines i

Else

'註解符號前一個字元為空格，才能確保是註解符號

If Mid(.Lines(i, 1), ftemp - 1, ftemp - 1) = " " Then

Strtemp = Mid(.Lines(i, 1), 1, ftemp - 1)

.ReplaceLine i, Strtemp '取代字串(清除註解)

End If

End If

End If

　

End If

Next i

End If

End With

Next Vbc

End Sub

---

Private Sub DLEvtModule_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)

'套用目前模組

With Application.VBE.ActiveCodePane.CodeModule

rCount = .CountOfLines

For i = rCount To 1 Step -1

Lentemp = Len(.Lines(i, 1)) '判斷是否為空行

If Lentemp = 0 Then

.DeleteLines i

End If

Next i

End With

End Sub

---

Private Sub DLEvtProject_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)

'套用專案中所有的模組

For Each Vbc In ActiveWorkbook.VBProject.VBComponents

With Vbc.CodeModule

rCount = .CountOfLines

For i = rCount To 1 Step -1

Lentemp = Len(.Lines(i, 1)) '判斷是否為空行

If Lentemp = 0 Then

.DeleteLines i

End If

Next i

End With

Next Vbc

End Sub

檔案下載:http://www.chijanzen.twmail.net/VBAFILE/vbe/F0009.htm

hhzjxss

QUOTE:

以下是引用FENGJUN在2004-9-23 13:32:00的发言：

如何将这个Faceids Addin做入VBE工具栏或其右键菜单中？

达到象图中的Smart Indent一样方便调用的目的。

http://j-walk.com/ss/excel/files/faceids.exe

下载了，安装后是个个Faceids的加载宏，谢谢了！

liucqa

VBE菜单和代码缩进.rar (23.91 KB, 下载次数: 139)

2013-9-17 23:13 上传

点击文件名下载附件

整理4楼的代码，顺便附一个代码缩进的实例

apoul119

求助 VB6.0开发vbe插件右键菜单激活时间问题
http://club.excelhome.net/thread-1325146-1-1.html