VBA 创建新工具栏
Sub newb()
CommandBars.Add "検索"
End Sub
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
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
这将创建一个名为“搜索工具栏”的新工具栏。但是,如果已经存在同名的工具栏,则会发生错误,因此您应该检查它,如下所示。
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
您必须使用以下代码创建它。请执行下列操作:
Sub AddTextBox()
With CommandBars("検索").Controls.Add(Type:=msoControlEdit)
.Caption = "EditBox"
.TooltipText = "検索語"
.OnAction = "SheetSearch"
End With
End Sub
Caption 属性是标识文本框的名称。
当您将鼠标指针悬停在文本框上时,会显示 TooltipText 属性中设置的字符串。
将 OnAction 属性设置为在文本框上按下 Enter 键时将执行的过程。这是正文
我做了一个程序来搜索在活动工作表的框中输入的字符串。
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 事件
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CommandBars("検索").Controls("EditBox").Text = _
Format(WorksheetFunction.Sum(Target.Value), "#,##")
End Sub

浙公网安备 33010602011771号