Sub 创建工具栏()
On Error GoTo ERRTEXT
Dim JXMBAR As CommandBar
Dim NewItem
For Each JXMBAR In CommandBars
If JXMBAR.Name = "工具栏" Then
Application.CommandBars("工具栏").Delete
End If
Next
Application.CommandBars.Add(Name:="工具栏").Visible = True
With CommandBars("工具栏")
.Position = msoBarFloating
End With
Set NewItem = CommandBars("工具栏").Controls.Add(Type:=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "简化界面"
.FaceId = 69
.OnAction = "简化界面"
.Style = msoButtonIconAndCaption
.TooltipText = "简化界面"
End With
Set NewItem = CommandBars("工具栏").Controls.Add(Type:=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "恢复界面"
.FaceId = 1612
.OnAction = "恢复界面("
.Style = msoButtonIconAndCaption
.TooltipText = "简化界面"
End With
Exit Sub
ERRTEXT:
MsgBox Err.Description
End Sub
Sub 简化界面()
Application.CommandBars("Worksheet Menu Bar").Enabled = False '菜单栏
Application.CommandBars("Toolbar List").Enabled = False '工具栏
Application.CommandBars("Standard").Visible = False '常用工具栏
Application.CommandBars("Formatting").Visible = False '格式工具栏
Application.DisplayFormulaBar = False '编辑栏
Application.DisplayStatusBar = False '状态栏
With ActiveWindow
.DisplayGridlines = False '网格
.DisplayHeadings = False '行号列标
.DisplayOutline = False '分级显示符号
.DisplayZeros = False '零值
.DisplayHorizontalScrollBar = True 'False '水平滚动条
.DisplayVerticalScrollBar = True 'False '垂直滚动条
.DisplayWorkbookTabs = False 'True '工作表标签
End With
Application.WindowState = xlMaximized '将EXCEL环境最大化
End Sub
Sub 恢复界面()
Application.CommandBars("Worksheet Menu Bar").Enabled = True '菜单栏
Application.CommandBars("Toolbar List").Enabled = True '工具栏
Application.CommandBars("Standard").Visible = True '常用工具栏
Application.CommandBars("Formatting").Visible = True '格式工具栏
Application.DisplayFormulaBar = True '编辑栏
Application.DisplayStatusBar = True '状态栏
With ActiveWindow
.DisplayGridlines = False 'True '网格
.DisplayHeadings = True '行号列标
.DisplayOutline = True '分级显示符号
.DisplayZeros = True '零值
.DisplayHorizontalScrollBar = True '水平滚动条
.DisplayVerticalScrollBar = True '垂直滚动条
.DisplayWorkbookTabs = True '工作表标签
End With
End Sub
請幫忙解決
問題一. 能否兩個宏(活動工具條一個按來回使用及文字,圖片自動更換)
謝謝