Commandbar Positioning

[Guest]

I have a commandbar that is created by VBA code. I want it displayed in a
particular location, with a height and width of my choosing.

Can't figure out the syntax to refer to the commandbar and its properties.

Thankyou in advance.

 

[Rowan Drummond]

Maybe this will help. These routines create and remove a toolbar on the
fly - from Dave Peterson if I recall correctly:

'*************************************************************
'Create and remove toolbar on the fly
'Add workbook open and before close routines to call these
'macros
'*************************************************************
Private Sub create_menubar()
Dim i As Long

Dim mac_names As Variant
Dim btn_faces As Variant
Dim tip_text As Variant

Call remove_menubar

mac_names = Array("mac1", _
"mac2", _
"mac3", _
"mac4", _
"mac5")


btn_faces = Array(97, _
94, _
102, _
80, _
93)


tip_text = Array("tip 1", _
"tip 2", _
"tip 3", _
"tip 4", _
"tip 5")


With Application.CommandBars.Add
.Name = "MyToolbar"
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating


For i = LBound(mac_names) To UBound(mac_names)
With .Controls.Add(Type:=msoControlButton)
.OnAction = ThisWorkbook.Name & "!" & mac_names(i)
.Style = msoButtonIcon
.FaceId = btn_faces(i)
.TooltipText = tip_text(i)
End With
Next i
End With
End Sub

Private Sub remove_menubar()
On Error Resume Next
Application.CommandBars("MyToolbar").Delete
On Error GoTo 0
End Sub

Hope this helps
Rowan

 

[Guest]

I was able to use some of what you provided, but I am not able to change the
height or width of the toolbar to show all the buttons. Any further ideas?

Here is the code I'm running...

With Application.CommandBars.Add
.Name = "FaceID1"
.Left = 30
.Top = 115
.Height = 308
.Width = 903
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating
End With

 

[Rowan Drummond]

How many buttons are you adding? It is not normally neccessary to size
the toolbar - it will automatically stretch to show all the buttons.

Regards
Rowan

 

[Guest]

I am running a routine that adds face ID's to the toolbar, so that I can
'see' which one I would like to use in/for my apps. I am creating 2 toolbars
that contain 500 buttons each.

I change the .toolbartip to the face ID number, .onaction = xlnone.

Seems extreme, but it allows me to select the face ID's easily.

The .top and .left properties seem to be working, just the .height and
..width are not working at all.

 

[Rowan Drummond]

There are a number of free addins available that do this already. I use
Jim Rech's BtnFaces which you can get here
http://www.BMSLtd.ie/MVP/Default.htm

The code below from RB Smissaert places all the faceids onto the
activesheet (make sure this is a blank sheet):

'----------------------------------------------------------
Sub ShowAllFaceID()

Dim CBC As CommandBarControl
Dim i As Long
Dim n As Long
Dim c As Long
Dim strSpacer As String
Dim lFaceIDCount As Long
Dim Sh As Shape

Application.ScreenUpdating = False
Application.Cursor = xlWait
strSpacer = "~" & String(3, Chr(32))
Cells.Clear

'get rid of the old FaceID's first
'---------------------------------
For Each Sh In ActiveSheet.Shapes
Sh.Delete
Next

Set CBC = _
CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlButton, _
temporary:=True)

Do
If i Mod 12 = 0 Then
n = n + 1
c = 1
Else
c = c + 1
End If
i = i + 1
On Error GoTo ERROROUT
CBC.FaceId = i
On Error Resume Next
CBC.CopyFace
If Err.Number = 0 Then
Cells(n, c) = strSpacer & i
ActiveSheet.Paste Cells(n, c)
Else
Err.Clear
End If
Application.StatusBar = _
" Dumping all Office FaceID's in sheet, please wait ... " & i
Loop

ERROROUT:
CBC.Delete

With ActiveSheet.DrawingObjects
.ShapeRange.ScaleWidth 1.28, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 1.28, msoFalse, msoScaleFromTopLeft
Range(Cells(1), Cells(n, 1)).RowHeight = .ShapeRange.Height
End With

Range(Cells(1), Cells(n, 12)).Columns.AutoFit

With Application
.ScreenUpdating = True
.Cursor = xlDefault
.StatusBar = False
End With

End Sub
'---------------------------------------------------------

Hope this helps
Rowan