B
Bishop
The following code is three subs that create a toolbar, create a button for
that toolbar, and a macro that runs when the button is pushed:
Sub CatalystDumpToolBar()
Dim CDToolBar As CommandBar
Set CDToolBar = CommandBars.Add(temporary:=True)
With CDToolBar
.Name = "CDToolBar"
.Position = msoBarTop
.Visible = True
End With
End Sub
__________________________________________
Sub CatalystToTally()
Dim wb As Workbook
Dim ws As Worksheet
Dim CDLastRow As Integer
Dim EDLastRow As Integer
With Sheets("Catalyst Dump")
CDLastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Columns("D").ColumnWidth = 13
End With
For Each wb In Workbooks
'Test to see if wb's name is like "ExportedData*"
If wb.Name Like "ExportedData*" Then
'Create a worksheet object to reference the appropriate
'worksheet in the wb
Set ws = wb.ActiveSheet
With ws
.Rows("1:1").Delete Shift:=xlUp
EDLastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Columns("D").ColumnWidth = 13
.Columns("D").NumberFormat = "0"
.Rows("1:" & EDLastRow).Copy ThisWorkbook.Worksheets _
("Catalyst Dump").Rows(CDLastRow + 1)
End With
wb.Close savechanges:=False
End If
Next
End Sub
_____________________________________________
Sub AddCustomControl()
Dim CBar As CommandBar
Dim CTTally As CommandBarControl
Set CBar = CommandBars("CDToolBar")
Set CTTally = CBar.Controls.Add(Type:=msoControlButton)
With CTTally
.FaceId = 1763
.OnAction = "CatalystToTally"
End With
CBar.Visible = True
End Sub
_____________________________________________
This code checks to see if the toolbar already exists when the sheet is
opened. If it is, nothing happens, if it isn't then everything gets added:
Private Sub Workbook_Open()
'The following code checks to see if the CDToolBar is present
'in Excel. If it isn't it puts it there. If it is it does nothing
Dim cbr As CommandBar
On Error Resume Next
Set cbr = Application.CommandBars("CDToolBar")
On Error GoTo 0
If cbr Is Nothing Then
Call CatalystDumpToolBar
Call AddCustomControl
End If
If ThisWorkbook.Name Like "Master*" Then NotSoFast.Show
End Sub
_____________________________________________
The problem is I built this for 2003 but it won't run in 2007. I get no
errors. Nothing happens. That I can tell... how do I fix this?
that toolbar, and a macro that runs when the button is pushed:
Sub CatalystDumpToolBar()
Dim CDToolBar As CommandBar
Set CDToolBar = CommandBars.Add(temporary:=True)
With CDToolBar
.Name = "CDToolBar"
.Position = msoBarTop
.Visible = True
End With
End Sub
__________________________________________
Sub CatalystToTally()
Dim wb As Workbook
Dim ws As Worksheet
Dim CDLastRow As Integer
Dim EDLastRow As Integer
With Sheets("Catalyst Dump")
CDLastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Columns("D").ColumnWidth = 13
End With
For Each wb In Workbooks
'Test to see if wb's name is like "ExportedData*"
If wb.Name Like "ExportedData*" Then
'Create a worksheet object to reference the appropriate
'worksheet in the wb
Set ws = wb.ActiveSheet
With ws
.Rows("1:1").Delete Shift:=xlUp
EDLastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Columns("D").ColumnWidth = 13
.Columns("D").NumberFormat = "0"
.Rows("1:" & EDLastRow).Copy ThisWorkbook.Worksheets _
("Catalyst Dump").Rows(CDLastRow + 1)
End With
wb.Close savechanges:=False
End If
Next
End Sub
_____________________________________________
Sub AddCustomControl()
Dim CBar As CommandBar
Dim CTTally As CommandBarControl
Set CBar = CommandBars("CDToolBar")
Set CTTally = CBar.Controls.Add(Type:=msoControlButton)
With CTTally
.FaceId = 1763
.OnAction = "CatalystToTally"
End With
CBar.Visible = True
End Sub
_____________________________________________
This code checks to see if the toolbar already exists when the sheet is
opened. If it is, nothing happens, if it isn't then everything gets added:
Private Sub Workbook_Open()
'The following code checks to see if the CDToolBar is present
'in Excel. If it isn't it puts it there. If it is it does nothing
Dim cbr As CommandBar
On Error Resume Next
Set cbr = Application.CommandBars("CDToolBar")
On Error GoTo 0
If cbr Is Nothing Then
Call CatalystDumpToolBar
Call AddCustomControl
End If
If ThisWorkbook.Name Like "Master*" Then NotSoFast.Show
End Sub
_____________________________________________
The problem is I built this for 2003 but it won't run in 2007. I get no
errors. Nothing happens. That I can tell... how do I fix this?