VBA 创建新工具栏

1 2 3

Sub newb()     CommandBars.Add "検索" End Sub

 

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Option Explicit Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMillsecounds As Long)   Private Sub CommandButton1_Click()の後半を変更。 ： 　　With Application.CommandBars("Font Color") 　　　　.Position = msoBarFloating 　　　　.Left = L * DPI / PPI 　　　　.Top = T * DPI / PPI 　　　　.Visible = True 　　　　While .Visible 　　　　　　Sleep 1 　　　　　　DoEvents 　　　　Wend 　　End With 　　Me.CommandButton1.BackColor = ActiveCell.Font.Color End Sub

　　

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Dim cmbShortcutMenu As Office.CommandBar   ' Create the new pop-up menu instance Set cmbShortcutMenu = CommandBars.Add("popupFormatMenu", msoBarPopup, False, True)   ' Add the bold button cmbShortcutMenu.Controls.Add Type:=msoControlButton, id:=113 ' Add the italic button cmbShortcutMenu.Controls.Add Type:=msoControlButton, id:=114 ' Add the underline button cmbShortcutMenu.Controls.Add Type:=msoControlButton, id:=115 ' Add the numbered list button cmbShortcutMenu.Controls.Add Type:=msoControlButton, id:=11 ' Add the bullet list button cmbShortcutMenu.Controls.Add Type:=msoControlButton, id:=12   Set cmbShortcutMenu = Nothing

这将创建一个名为“搜索工具栏”的新工具栏。但是，如果已经存在同名的工具栏，则会发生错误，因此您应该检查它，如下所示。

1 2 3 4 5 6 7 8 9 10

Sub newb()     Dim tb As Variant     For Each tb In CommandBars         If tb.Name = "検索" Then             MsgBox "同名", 16             Exit Sub         End If     Next tb     CommandBars.Add "検索ー" End Sub

现在，当您想在工具栏上放置按钮等控件时，从[自定义]对话框中拖放它。但是，没有可以放在任何地方的文本框。放置在工具栏上的文本框是VBA

您必须使用以下代码创建它。请执行下列操作：

1 2 3 4 5 6 7

Sub AddTextBox()     With CommandBars("検索").Controls.Add(Type:=msoControlEdit)         .Caption = "EditBox"         .TooltipText = "検索語"         .OnAction = "SheetSearch"     End With End Sub

Caption 属性是标识文本框的名称。

当您将鼠标指针悬停在文本框上时，会显示 TooltipText 属性中设置的字符串。

将 OnAction 属性设置为在文本框上按下 Enter 键时将执行的过程。这是正文

我做了一个程序来搜索在活动工作表的框中输入的字符串。

1 2 3 4 5

Sub SheetSearch()     Dim FoundCell As Variant     Set FoundCell = Cells.Find(What:=CommandBars("検索").Controls("EditBox").Text)     If Not FoundCell Is Nothing Then FoundCell.Activate End Sub

根据需要设置 Find 方法的参数。

此外，结合工作表的 SelectionChange 事件

1 2 3 4

Private Sub Worksheet_SelectionChange(ByVal Target As Range)     CommandBars("検索").Controls("EditBox").Text = _                   Format(WorksheetFunction.Sum(Target.Value), "#,##") End Sub