Code help: dialogue box to add a toolbar

[TheMachine]

I use the following to add a toolbar that hides/unhides columns in my spreadsheet. I need a code so I can use this for any spreadsheet, and the user must enter the row number with the column headers into a Dialogue box and it makes a toolbar accordingly. Here is the code I currently have:

Toolbar:
Private Sub Workbook_Open()
ShowHide
End Sub

Sub ShowHide()
Dim cbarName As String
cbarName = "Show/Hide"
Dim cbar As CommandBar
'Delete bar if it exists.
On Error Resume Next
Application.CommandBars(cbarName).Delete
On Error GoTo 0
'Add bar
Set cbar = Application.CommandBars.Add(Name:=cbarName)
Dim i As Long
For i = 2 To 78
Dim Ctrl As CommandBarButton
Set Ctrl = cbar.Controls.Add(msoControlButton)
With Ctrl
.Caption = ActiveSheet.Cells(11, i).Value
.OnAction = "ButtonToggle"
.Style = msoButtonCaption
.State = Columns(i).EntireColumn.Hidden
.Tag = "0"
If .Caption = "" Then
.Visible = False
End If
End With
Next i
cbar.Visible = True
End Sub

and module

Sub ButtonToggle()
Dim ctlPressed As CommandBarButton
Dim i As Long
Set ctlPressed = Application.CommandBars.ActionControl
With ctlPressed
If .State = msoButtonDown Then
.State = msoButtonUp
Else
.State = msoButtonDown
End If
Dim idx As Long
idx = .Index + 1
Columns(idx).Hidden = .State
idx = idx + 1
While Columns(idx).Cells(11).Value = "" And idx < 78
Columns(idx).Hidden = .State
idx = idx + 1
Wend
End With
End Sub


If anyone would know the correct code for this it would be (read:) GREATLY appreciated.

[Bob Phillips]

Your commandbar will be enormous if you make it available to all sheets (it could get enormous on one sheet.

Is that a good idea? What is the rationale behind it?

[TheMachine]

Your commandbar will be enormous if you make it available to all sheets (it could get enormous on one sheet.

Is that a good idea? What is the rationale behind it?

You can adjust the size of the toolbar, the code above is for a sheet with 79 columns and it works fine.

[Bob Phillips]

Well I have an alternative suggestion if you are interested



Sub ShowHide()
Dim cbarName As String
Dim cbar As CommandBar
Dim i As Long
Dim Sh As Worksheet
Dim Ctrl As CommandBarControl
Dim fEmpty As Boolean

cbarName = "Show/Hide"

'Delete bar if it exists.
On Error Resume Next
Application.CommandBars(cbarName).Delete
On Error GoTo 0

'Add bar
Set cbar = Application.CommandBars.Add(Name:=cbarName)
For Each Sh In ThisWorkbook.Worksheets
Set Ctrl = cbar.Controls.Add(Type:=msoControlComboBox)
With Ctrl
fEmpty = True
.Caption = Sh.Name
.Tag = Application.Rept("0", 78)
.AddItem Sh.Name
For i = 2 To 78
If Sh.Cells(11, i).Value <> "" Then
.AddItem "[" & i & "]: " & Sh.Cells(11, i).Value
fEmpty = False
End If
If Sh.Cells(11, i).EntireColumn.Hidden Then
.Tag = Left$(.Tag, i - 1) & "1" & Right$(.Tag, Len(.Tag) - i)
End If
Next i
.Visible = (Sh.Name = ActiveSheet.Name) And Not fEmpty
.ListIndex = 1
.Parameter = fEmpty
.OnAction = "ButtonToggle"
End With
Next Sh
cbar.Visible = True
End Sub

Sub ButtonToggle()
Dim mpCombo As CommandBarControl
Dim i As Long
Dim mpColumnBit As Long

Set mpCombo = Application.CommandBars.ActionControl
With mpCombo
If .Text <> ActiveSheet.Name Then
i = Mid$(.Text, 2, InStr(.Text, "]") - 2)
mpColumnBit = Mid$(.Tag, i, 1)
If mpColumnBit = 0 Then
ActiveSheet.Columns(i).Hidden = True
.Tag = Left$(.Tag, i - 1) & "1" & Right$(.Tag, Len(.Tag) - i)
Else
ActiveSheet.Columns(i).Hidden = False
.Tag = Left$(.Tag, i - 1) & "0" & Right$(.Tag, Len(.Tag) - i)
End If
.Text = ActiveSheet.Name
End If
End With
End Sub


and you add this coe to activeate the correct one



Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim mpCombo As CommandBarComboBox
With Application.CommandBars("Show/Hide")
For Each mpCombo In .Controls
mpCombo.Visible = (mpCombo.Caption = Sh.Name) And Not CBool(mpCombo.Parameter)
Next mpCombo
.Visible = True
End With
End Sub


This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

[TheMachine]

Well I have an alternative suggestion if you are interested



Sub ShowHide()
Dim cbarName As String
Dim cbar As CommandBar
Dim i As Long
Dim Sh As Worksheet
Dim Ctrl As CommandBarControl
Dim fEmpty As Boolean

cbarName = "Show/Hide"

'Delete bar if it exists.
On Error Resume Next
Application.CommandBars(cbarName).Delete
On Error GoTo 0

'Add bar
Set cbar = Application.CommandBars.Add(Name:=cbarName)
For Each Sh In ThisWorkbook.Worksheets
Set Ctrl = cbar.Controls.Add(Type:=msoControlComboBox)
With Ctrl
fEmpty = True
.Caption = Sh.Name
.Tag = Application.Rept("0", 78)
.AddItem Sh.Name
For i = 2 To 78
If Sh.Cells(11, i).Value <> "" Then
.AddItem "[" & i & "]: " & Sh.Cells(11, i).Value
fEmpty = False
End If
If Sh.Cells(11, i).EntireColumn.Hidden Then
.Tag = Left$(.Tag, i - 1) & "1" & Right$(.Tag, Len(.Tag) - i)
End If
Next i
.Visible = (Sh.Name = ActiveSheet.Name) And Not fEmpty
.ListIndex = 1
.Parameter = fEmpty
.OnAction = "ButtonToggle"
End With
Next Sh
cbar.Visible = True
End Sub

Sub ButtonToggle()
Dim mpCombo As CommandBarControl
Dim i As Long
Dim mpColumnBit As Long

Set mpCombo = Application.CommandBars.ActionControl
With mpCombo
If .Text <> ActiveSheet.Name Then
i = Mid$(.Text, 2, InStr(.Text, "]") - 2)
mpColumnBit = Mid$(.Tag, i, 1)
If mpColumnBit = 0 Then
ActiveSheet.Columns(i).Hidden = True
.Tag = Left$(.Tag, i - 1) & "1" & Right$(.Tag, Len(.Tag) - i)
Else
ActiveSheet.Columns(i).Hidden = False
.Tag = Left$(.Tag, i - 1) & "0" & Right$(.Tag, Len(.Tag) - i)
End If
.Text = ActiveSheet.Name
End If
End With
End Sub

and you add this coe to activeate the correct one



Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim mpCombo As CommandBarComboBox
With Application.CommandBars("Show/Hide")
For Each mpCombo In .Controls
mpCombo.Visible = (mpCombo.Caption = Sh.Name) And Not CBool(mpCombo.Parameter)
Next mpCombo
.Visible = True
End With
End Sub


This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

Do I add both of these codes to View Code?

[Bob Phillips]

The first two replace your procedures, the last goes in the same module as your Workbook_Open code.

[TheMachine]

When I right click the Excel icon I can't get the "View Code" box to open for the last code...

[TheMachine]

http://img.waffleimages.com/63dbfef0b5f22858aab0023a62e7d579f04177f9/noriughtclick.jpg

[Bob Phillips]

I get a 'no linking from this host' error with that link

[Bob Phillips]

When I right click the Excel icon I can't get the "View Code" box to open for the last code...

SO how did you add your Workbook_Open code?

[TheMachine]

I just double clicked on This Workbook

[Bob Phillips]

So do it again.

[TheMachine]

So do it again.

So add the first and last code into This Workbook and the second code to Module?

[Bob Phillips]

No, first and second to a module, third to ThisWorkbook.

[TheMachine]

I ran it and it's just showing a small box with no headers on it.

[Bob Phillips]

Post your workbook.

[TheMachine]

I can't post my workbook, but do you really need it? Here is a working code for exactly what I want to do, but for a spreadsheet that has 79 column headers in row 11. I need a code to be able to do this but with any spreadsheet I add it to.

Module:


Sub ButtonToggle()
Dim ctlPressed As CommandBarButton
Dim i As Long
Set ctlPressed = Application.CommandBars.ActionControl
With ctlPressed
If .State = msoButtonDown Then
.State = msoButtonUp
Else
.State = msoButtonDown
End If
Dim idx As Long
idx = .Index + 1
Columns(idx).Hidden = .State
idx = idx + 1
While Columns(idx).Cells(11).Value = "" And idx < 78
Columns(idx).Hidden = .State
idx = idx + 1
Wend
End With


End Sub
Workbook:


Private Sub Workbook_Open()
ShowHide
End Sub

Sub ShowHide()
Dim cbarName As String
cbarName = "Show/Hide"
Dim cbar As CommandBar
'Delete bar if it exists.
On Error Resume Next
Application.CommandBars(cbarName).Delete
On Error GoTo 0
'Add bar
Set cbar = Application.CommandBars.Add(Name:=cbarName)
Dim labelRow As Long
labelRow = InputBox("Please enter the row number of the labels.", "Show/Hide", 11)
Dim i As Long
For i = 2 To 78
Dim Ctrl As CommandBarButton
Set Ctrl = cbar.Controls.Add(msoControlButton)
With Ctrl
.Caption = ActiveSheet.Cells(labelRow, i).Value
.OnAction = "ButtonToggle"
.Style = msoButtonCaption
.State = Columns(i).EntireColumn.Hidden
.Tag = "0"
If .Caption = "" Then
.Visible = False
End If
End With
Next i
cbar.Visible = True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ShowHide
End Sub

[Bob Phillips]

I thouht you were saying that you tried my code and it didn't work. MIne was multi-sheet enabled.