To Whome It May Concern:

At times I work with workbooks with numerous worksheets and chartsheets

(15+) and it becomes cumbersome to navigate through the workbook. I
have tried using the short-cut key strokes to navigate but this is time

consuming cycling back and forth, so I thought it would be nice to
create a custom toolbar to navigate such workbooks. I decided that two

drop down boxes would do nicely, one for navigating worksheets and the
other for chartsheets. I also thought about adding to arrow buttons,
"previous" and "next", to cycle through the workbook as well...?


Anyway the problem I ran into is that some of the worksheets and
chartsheets names are two large to fit in the drop down boxes (default
size); although you can manualy resize the drop down boxes by going to
tools -- customize and then resize any toolbar command-control, I
wanted to be able to have the drop down boxes resize automatically
based on the largest name of the worksheets' and chartsheets'.


Does anyone know if it is possible to program a macro to automatically
resize a toolbar command-control based on the largest name of a
worksheet/chartsheet?
And if so, how? It would be nice to have this feature so that I can
publish it as an add-in and not have to worry about adjusting it all
the time and having to deal with copying the code to other workbooks...



I originally wanted to make a verticle list of buttons (with the names
of the worksheets and chartsheets as captions) along the left-hand side

of the screen, but I could not figure out how to do it. Does any one
know if this is even possible? And if so, any words of wisdom?


Also if anyone has any suggestions or comments on what I am trying to
do I am open ears.
Much thanks to those who reply; cheers,
--Brian


If anyone is interested this is what I have done so far:


---------------------BEGINNING OF MACRO-------------------------------


'PUBLIC DECLARATIONS
Public TBar_Name
Public DD1_Name
Public DD2_Name


Private Sub worksheet_SelectionChange()
'AUTOMATICALLY CHANGE DROP DOWN BOX TEXT TO CURRENT/ACTIVE WORKSHEET


For i = 1 To ActiveWorkbook.Worksheets.Count
If ActiveSheet.name = Worksheets(i).name Then
CommandBars(TBar_Name).Controls(DD1_Name).ListInde x = i
Exit Sub
End If
Next i


'IF THERE'S NO WORKSHEET SELECTED, LEAVE DD BLANK
CommandBars(TBar_Name).Controls(DD1_Name).ListInde x = 0


End Sub


Private Sub Chartsheet_SelectionChange()
'AUTOMATICALLY CHANGE DROP DOWN BOX TEXT TO CURRENT/ACTIVE CHARTSHEET


For i = 1 To ActiveWorkbook.Charts.Count
If ActiveChart.name = Charts(i).name Then
CommandBars(TBar_Name).Controls(DD2_Name).ListInde x = i
Exit Sub
End If
Next i


'IF THERE'S NO CHART SELECTED, LEAVE DD BLANK
CommandBars(TBar_Name).Controls(DD2_Name).ListInde x = 0


End Sub


Sub Create_Toolbar()


Dim TBar As CommandBar
Dim NewDD As CommandBarControl


'VARIABLE DECLARATIONS
TBar_Name = "Workbook Navigator"
DD1_Name = "Worksheets"
DD2_Name = "Chartsheets"


'DELETE EXISTING TOOLBAR IF IT EXISTS
On Error Resume Next
CommandBars(TBar_Name).Delete
On Error GoTo 0


'CREATE NEW TOOLBAR
Set TBar = CommandBars.Add
With TBar
.name = TBar_Name
.Visible = True
End With


'ADD A DROPDOWN CONTROL FOR WORKSHEETS
Set NewDD =
CommandBars(TBar_Name).Controls.Add(Type:=msoContr olDropdown)
With NewDD
.Caption = DD1_Name
.OnAction = "Activate_Selected_Worksheet"
.Style = msoButtonAutomatic


'FILL THE DROP DOWN WITH THE NAMES OF THE WORKSHEETS WITHIN THE
WORKBOOK
For i = 1 To ActiveWorkbook.Worksheets.Count
.AddItem Worksheets(i).name
Next i
.ListIndex = 1
End With


'ADD DROPDOWN CONTROL FOR CHARTSHEETS
Set NewDD =
CommandBars(TBar_Name).Controls.Add(Type:=msoContr olDropdown)
With NewDD
.Caption = DD2_Name
.OnAction = "Activate_Selected_Chart"
.Style = msoButtonAutomatic


'FILL THE DROP DOWN WITH THE NAMES OF THE CHARTSHEETS WITHIN THE
WORKBOOK
For i = 1 To ActiveWorkbook.Charts.Count
.AddItem Charts(i).name
Next i
.ListIndex = 1
End With


End Sub


Sub Activate_Selected_Worksheet()


'ACTIVATE WORKSHEET WHEN IT IS CHOSEN FROM THE DROP DOWN BOX
With CommandBars(TBar_Name).Controls(DD1_Name)
Worksheets(.List(.ListIndex)).Activate
End With


End Sub


Sub Activate_Selected_Chart()


'ACTIVATE CHARTSHEET WHEN IT IS CHOSEN FROM THE DROP DOWN BOX
With CommandBars(TBar_Name).Controls(DD2_Name)
Charts(.List(.ListIndex)).Activate
End With


End Sub

Brian,

see below. The function needs a few api's to determine the exact text
length...

Use like

ddNew.Width = GetLongestItem(ddNew)


Cheerz,
Jurgen


Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function FindWindowEx Lib "user32.dll" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hDc As Long, ByVal lpsz As _
String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd _
As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As _
Long, ByVal hDc As Long) As Long

Function GetLongestItem(ByVal ccbControl As CommandBarComboBox) As Long
'Determine the longest item in a combo/dropdown (in pixels)

Dim Pt As POINTAPI
Dim hWnd As Long
Dim hDc As Long
Dim xPt As Long
Dim i As Integer

hWnd = FindWindowEx(0, 0, "XLMAIN", vbNullString)
hDc = GetWindowDC(hWnd)

With ccbControl
For i = 1 To .ListCount
GetTextExtentPoint32 hDc, .List(i), Len(.List(i)), Pt
If Pt.X xPt Then
xPt = Pt.X
End If
Next
End With

ReleaseDC hWnd, hDc
GetLongestItem = xPt

End Function



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


shoeless wrote in
groups.com

To Whome It May Concern:

At times I work with workbooks with numerous worksheets and
chartsheets

(15+) and it becomes cumbersome to navigate through the workbook. I
have tried using the short-cut key strokes to navigate but this is
time

consuming cycling back and forth, so I thought it would be nice to
create a custom toolbar to navigate such workbooks. I decided that
two

drop down boxes would do nicely, one for navigating worksheets and the
other for chartsheets. I also thought about adding to arrow buttons,
"previous" and "next", to cycle through the workbook as well...?


Anyway the problem I ran into is that some of the worksheets and
chartsheets names are two large to fit in the drop down boxes (default
size); although you can manualy resize the drop down boxes by going to
tools -- customize and then resize any toolbar command-control, I
wanted to be able to have the drop down boxes resize automatically
based on the largest name of the worksheets' and chartsheets'.


Does anyone know if it is possible to program a macro to automatically
resize a toolbar command-control based on the largest name of a
worksheet/chartsheet?
And if so, how? It would be nice to have this feature so that I can
publish it as an add-in and not have to worry about adjusting it all
the time and having to deal with copying the code to other
workbooks...



I originally wanted to make a verticle list of buttons (with the names
of the worksheets and chartsheets as captions) along the left-hand
side

of the screen, but I could not figure out how to do it. Does any one
know if this is even possible? And if so, any words of wisdom?


Also if anyone has any suggestions or comments on what I am trying to
do I am open ears.
Much thanks to those who reply; cheers,
--Brian


If anyone is interested this is what I have done so far:


---------------------BEGINNING OF MACRO-------------------------------


'PUBLIC DECLARATIONS
Public TBar_Name
Public DD1_Name
Public DD2_Name


Private Sub worksheet_SelectionChange()
'AUTOMATICALLY CHANGE DROP DOWN BOX TEXT TO CURRENT/ACTIVE WORKSHEET


For i = 1 To ActiveWorkbook.Worksheets.Count
If ActiveSheet.name = Worksheets(i).name Then
CommandBars(TBar_Name).Controls(DD1_Name).ListInde x = i
Exit Sub
End If
Next i


'IF THERE'S NO WORKSHEET SELECTED, LEAVE DD BLANK
CommandBars(TBar_Name).Controls(DD1_Name).ListInde x = 0


End Sub


Private Sub Chartsheet_SelectionChange()
'AUTOMATICALLY CHANGE DROP DOWN BOX TEXT TO CURRENT/ACTIVE CHARTSHEET


For i = 1 To ActiveWorkbook.Charts.Count
If ActiveChart.name = Charts(i).name Then
CommandBars(TBar_Name).Controls(DD2_Name).ListInde x = i
Exit Sub
End If
Next i


'IF THERE'S NO CHART SELECTED, LEAVE DD BLANK
CommandBars(TBar_Name).Controls(DD2_Name).ListInde x = 0


End Sub


Sub Create_Toolbar()


Dim TBar As CommandBar
Dim NewDD As CommandBarControl


'VARIABLE DECLARATIONS
TBar_Name = "Workbook Navigator"
DD1_Name = "Worksheets"
DD2_Name = "Chartsheets"


'DELETE EXISTING TOOLBAR IF IT EXISTS
On Error Resume Next
CommandBars(TBar_Name).Delete
On Error GoTo 0


'CREATE NEW TOOLBAR
Set TBar = CommandBars.Add
With TBar
.name = TBar_Name
.Visible = True
End With


'ADD A DROPDOWN CONTROL FOR WORKSHEETS
Set NewDD =
CommandBars(TBar_Name).Controls.Add(Type:=msoContr olDropdown)
With NewDD
.Caption = DD1_Name
.OnAction = "Activate_Selected_Worksheet"
.Style = msoButtonAutomatic


'FILL THE DROP DOWN WITH THE NAMES OF THE WORKSHEETS WITHIN THE
WORKBOOK
For i = 1 To ActiveWorkbook.Worksheets.Count
.AddItem Worksheets(i).name
Next i
.ListIndex = 1
End With


'ADD DROPDOWN CONTROL FOR CHARTSHEETS
Set NewDD =
CommandBars(TBar_Name).Controls.Add(Type:=msoContr olDropdown)
With NewDD
.Caption = DD2_Name
.OnAction = "Activate_Selected_Chart"
.Style = msoButtonAutomatic


'FILL THE DROP DOWN WITH THE NAMES OF THE CHARTSHEETS WITHIN THE
WORKBOOK
For i = 1 To ActiveWorkbook.Charts.Count
.AddItem Charts(i).name
Next i
.ListIndex = 1
End With


End Sub


Sub Activate_Selected_Worksheet()


'ACTIVATE WORKSHEET WHEN IT IS CHOSEN FROM THE DROP DOWN BOX
With CommandBars(TBar_Name).Controls(DD1_Name)
Worksheets(.List(.ListIndex)).Activate
End With


End Sub


Sub Activate_Selected_Chart()


'ACTIVATE CHARTSHEET WHEN IT IS CHOSEN FROM THE DROP DOWN BOX
With CommandBars(TBar_Name).Controls(DD2_Name)
Charts(.List(.ListIndex)).Activate
End With


End Sub

Thanks a lot keepITcool!

That worked great...

Cheers,
--Shoeless