Buttons in Toolbars

  • Thread starter Thread starter Tommi
  • Start date Start date
T

Tommi

Hello!
Is it possible to make own Buttons in Toolbars (which then will run my
VBA-code) so that they will be displayed only if I open a certain workbook
(I don't want buttons that will be displayed always when using Excel - only
when I am using that certain workbook)? If it is possible, could someone
help me and say how?

Thanks very much!

BR,
Tommi
 
This is a macro a got a while ago. Copy and paste this
code below into a macro and put a line like

Application.Run "DistrictPlanApps.xls!
CreateCustomCommandBar"

into the source code

hth
Jonny




Private Sub CreateCustomCommandBar()


Application.CommandBars("Standard").Visible = False
Application.CommandBars("Formatting").Visible = False

Dim cb As CommandBar, cbMenu As CommandBarPopup, cbButton
As CommandBarButton
DeleteCustomCommandBar ' delete the commandbar if it
already exists

Set cb = Application.CommandBars.Add
(ThisCommandBarName, msoBarTop, False, True)

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Penwith"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!penwith"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\penwith.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Condense Penwith Applications"
End With

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Kerrier 1"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!kerrierfirst"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\kerrier1.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Sort oout Kerrier Applications"
End With

' add a button to the commandbar, use a custom
FaceId from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Kerrier 2"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!kerriersecond"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\kerrier2.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Condense Kerrier Applications"
End With

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Carrick"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!carrick"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\carrick.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Condense carrick Applications"
End With

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Restormel"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!restormel"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\restormel.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Condense restormel Applications"
End With

' add a button to the commandbar, use a custom
FaceId from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Caradon"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!caradon"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\caradon.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Condense Caradon Applications"
End With

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "North C"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!northc"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\Northc.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Condense North Cornwall
Applications"
End With


' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Main"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!Main"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\compile.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Compile all data into list"
End With

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Merge"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!mergedata"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\merge.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Merge cell with data to the right"
End With

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Split"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!split"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\split.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Split cell at hyphen"
End With


Set cbButton = cb.Controls.Add
(Type:=msoControlButton, ID:=3829, Before:=11)
With cbButton
.Caption = "Import Data"
.Style = msoButtonIconAndCaption
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\import.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Import Data via a New Web Query"
End With

' add a button to the commandbar, use a custom FaceId
from a file
Set cbButton = cb.Controls.Add
(msoControlButton, , , , True)
With cbButton
.Caption = "Export"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!exportdata"
' insert an icon from a file
If CopyPictureFromFile(shtCustomIcons,
ThisWorkbook.Path & "\buttons\export.bmp") Then
.PasteFace ' paste the custom icon
End If
.TooltipText = "Exports Compiled Data to External
File"
End With



cb.Visible = True ' display the custom commandbar
Set cbButton = Nothing
Set cbMenu = Nothing
Set cb = Nothing
End Sub

Private Sub DeleteCustomCommandBar()
' delete the commandbar if it already exists
On Error Resume Next
Application.CommandBars(ThisCommandBarName).Delete
On Error GoTo 0
End Sub

Private Sub Macroname()
' dummy macro for the buttons on the commandbar created
by CreateCustomCommandBar
If Application.CommandBars.ActionControl Is Nothing
Then ' not started from a commandbar
MsgBox "This could be your macro running!",
vbInformation, ThisWorkbook.Name
Else ' started from a commandbar control
MsgBox "This could be your macro running!",
vbInformation, _
"Started by " &
Application.CommandBars.ActionControl.Caption
End If
End Sub

Function CopyPictureFromFile(TargetWS As Worksheet,
SourceFile As String) As Boolean
' inserts a picture from SourceFile into TargetWS
' copies the picture to the clipboard
' deletes the inserted picture
' returns TRUE if a picture is copied to the clipboard
' the picture can be pasted from the clipboard e.g. to a
custom commbarbutton
Dim p As Object
CopyPictureFromFile = False
If TargetWS Is Nothing Then Exit Function
If Len(Dir(SourceFile)) = 0 Then Exit Function
On Error GoTo NoPicture
Set p = TargetWS.Pictures.Insert(SourceFile)
p.CopyPicture xlScreen, xlPicture
p.Delete
Set p = Nothing
On Error GoTo 0
CopyPictureFromFile = True
Exit Function
NoPicture:
End Function
 
Hi Tommi,

Yes,
Via menu : View/toolbar/customise
In the toobars page, Click new & give it a name.
In the "commands"page, choose Macros (categories) and select a custom
button.
for each button you can assign a macro.
When finished, go back to the toolbar page and choose "attach" (to attach
that toolbar to that particular workbook.
In the VBA project, slect the workbook object "Thisworkbook "and add some
event sub such as

Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
On Error Resume Next
Application.CommandBars("your toolbar name").Visible = True
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Excel.Window)
On Error Resume Next
Application.CommandBars("your toolbar name").Visible = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("your toolbar name").Delete
End Sub

Regards,

Jean-Yves
 
Back
Top