This code is throwing nothing but errors in VBA:

Private WithEvents objCommandBarButton As CommandBarButton

Private Sub Workbook_Open()
Dim obkCommandbars As CommandBars
Dim objCommandBar As CommandBar
Dim objCommandBarControl As CommandBarControl

' Create a menu command on the "Tools" menu.
objCommandBars = Me.Application.CommandBars("Tools")
objCommandBar = objCommandBars.Item("Tools")

' Make sure menu command doesn't already exist.
For Each objCommandBarControl In objCommandBar.Controls
If objCommandBarControl.Caption = "Perform Metric conversion..."
Then
objCommandBar.Controls.Item("Perform Metric
conversion...").Delete
End If
Next objCommandBarControl

objCommandBarButton = objCommandBar.Controls.Add(msoControlButton)

With objCommandBarButton
.Caption = "Perform Metrics Conversion..."
.Style = msoButtonCaption
.Tag = "Perform Metrics Conversion..."
.OnAction = "!<Magic_Metrics.Connect"
.Visible = True
End With
End Sub

AM I missing something here?

Jody W

I'm just guessing here but:

Shouldn't Dim obkCommandbars As CommandBars be Dim objCommandbars As
CommandBars

And aren't these "objects" meaning the assignment statements must begin
with "SET" e.g.:

SET objCommandBars = Me.Application.CommandBars("Tools")
SET objCommandBar = objCommandBars.Item("Tools")

and the
objCommandBarButton = objCommandBar.Controls.Add(msoControlButton)
A: hasn't been dimmed and as an Object I would think it should be and
B: again the assignment statement should be a "SET"

Just guessing...

What kind of errors is VBA giving you?

BAC
"Jody L. Whitlock" wrote:

This code is throwing nothing but errors in VBA:

Private WithEvents objCommandBarButton As CommandBarButton

Private Sub Workbook_Open()
Dim obkCommandbars As CommandBars
Dim objCommandBar As CommandBar
Dim objCommandBarControl As CommandBarControl

' Create a menu command on the "Tools" menu.
objCommandBars = Me.Application.CommandBars("Tools")
objCommandBar = objCommandBars.Item("Tools")

' Make sure menu command doesn't already exist.
For Each objCommandBarControl In objCommandBar.Controls
If objCommandBarControl.Caption = "Perform Metric conversion..."
Then
objCommandBar.Controls.Item("Perform Metric
conversion...").Delete
End If
Next objCommandBarControl

objCommandBarButton = objCommandBar.Controls.Add(msoControlButton)

With objCommandBarButton
.Caption = "Perform Metrics Conversion..."
.Style = msoButtonCaption
.Tag = "Perform Metrics Conversion..."
.OnAction = "!<Magic_Metrics.Connect"
.Visible = True
End With
End Sub

AM I missing something here?

Jody W

The error I'm getting is 'Object Required' on this line:

' Create a menu command on the "Tools" menu.
Set objCommandbars = applicationObject.CommandBars

I haven't done VBA/VB6 in a while since I have moved onto .NET.


Thanks,
Jody

Jody L. Whitlock wrote:

he error I'm getting is 'Object Required' on this line:

' Create a menu command on the "Tools" menu.
Set objCommandbars = applicationObject.CommandBars

I haven't done VBA/VB6 in a while since I have moved onto .NET.


Thanks,
Jody

Okay, I got a different error, "Invalid use of property". Here's my
code:

Private WithEvents objCommandBarButton As CommandBarButton

Private Sub Workbook_Open()
Dim objCommandbars As CommandBars
Dim objCommandBar As CommandBar
Dim objCommandBarControl As CommandBarControl

' Create a menu command on the "Tools" menu.
objCommandbars = applicationObject.CommandBars
objCommandBar = objCommandbars.Item("Tools")

' Make sure menu command doesn't already exist.
For Each objCommandBarControl In objCommandBar.Controls
If objCommandBarControl.Caption = "Perform Metric conversion..."
Then
objCommandBar.Controls.Item("Perform Metric
conversion...").Delete
End If
Next objCommandBarControl

objCommandBarButton = objCommandBar.Controls.Add(msoControlButton)

With objCommandBarButton
.Caption = "Perform Metrics Conversion..."
.Style = msoButtonCaption
.Tag = "Perform Metrics Conversion..."
.OnAction = "!<Magic_Metrics.Connect"
.Visible = True
End With
End Sub

I'm going to do somemore research and try to figure out what is going
on.

Thanks again,
jody

Jody,

The tools menu is not a commandbar, but it is a CommandBarPopup.

Here's how Rob Bovey does it:

Sub Auto_Open()
Public Const glMENU_TOOLS As Long = 30007
Dim lCount As Long
Dim ctlToolsMenu As Office.CommandBarPopup
Dim ctlXYPopup As Office.CommandBarPopup
Dim ctlSub1 As Office.CommandBarButton
Dim ctlSub2 As Office.CommandBarButton
Dim ctlSub3 As Office.CommandBarButton
Dim ctlSub4 As Office.CommandBarButton

For lCount = 1 To 2

Set ctlToolsMenu = Application.CommandBars(lCount).FindControl(, glMENU_TOOLS)

On Error Resume Next
''' Always attempt to delete any currently existing instance of our menu that
''' might have been left hanging around by a crash.
ctlToolsMenu.Controls(gszMENU_APP).Delete
On Error GoTo 0

Set ctlXYPopup = ctlToolsMenu.Controls.Add(msoControlPopup)
'.... Other code


Next lCount

End Sub


HTH,
Bernie
MS Excel MVP


"Jody L. Whitlock" wrote in message
...
Jody L. Whitlock wrote:

he error I'm getting is 'Object Required' on this line:

' Create a menu command on the "Tools" menu.
Set objCommandbars = applicationObject.CommandBars

I haven't done VBA/VB6 in a while since I have moved onto .NET.


Thanks,
Jody

Okay, I got a different error, "Invalid use of property". Here's my
code:

Private WithEvents objCommandBarButton As CommandBarButton

Private Sub Workbook_Open()
Dim objCommandbars As CommandBars
Dim objCommandBar As CommandBar
Dim objCommandBarControl As CommandBarControl

' Create a menu command on the "Tools" menu.
objCommandbars = applicationObject.CommandBars
objCommandBar = objCommandbars.Item("Tools")

' Make sure menu command doesn't already exist.
For Each objCommandBarControl In objCommandBar.Controls
If objCommandBarControl.Caption = "Perform Metric conversion..."
Then
objCommandBar.Controls.Item("Perform Metric
conversion...").Delete
End If
Next objCommandBarControl

objCommandBarButton = objCommandBar.Controls.Add(msoControlButton)

With objCommandBarButton
.Caption = "Perform Metrics Conversion..."
.Style = msoButtonCaption
.Tag = "Perform Metrics Conversion..."
.OnAction = "!<Magic_Metrics.Connect"
.Visible = True
End With
End Sub

I'm going to do somemore research and try to figure out what is going
on.

Thanks again,
jody

Bernie Deitrick wrote:

Sub Auto_Open()
Public Const glMENU_TOOLS As Long = 30007
Dim lCount As Long
Dim ctlToolsMenu As Office.CommandBarPopup
Dim ctlXYPopup As Office.CommandBarPopup
Dim ctlSub1 As Office.CommandBarButton
Dim ctlSub2 As Office.CommandBarButton
Dim ctlSub3 As Office.CommandBarButton
Dim ctlSub4 As Office.CommandBarButton

For lCount = 1 To 2

Set ctlToolsMenu =
Application.CommandBars(lCount).FindControl(, glMENU_TOOLS)

On Error Resume Next
''' Always attempt to delete any currently existing
instance of our menu that ''' might have been left hanging
around by a crash.
ctlToolsMenu.Controls(gszMENU_APP).Delete On Error GoTo 0

Set ctlXYPopup = ctlToolsMenu.Controls.Add(msoControlPopup)
'.... Other code


Next lCount

Okay, now I get a variable not set error. Maybe I am missing something
vital here.....

Here's my code (* shows where error occurs):

Private WithEvents objCommandBarButton As CommandBarButton

Sub Auto_Open()
Const glMENU_TOOLS As Long = 30007
Dim lCount As Long
Dim ctlToolsMenu As Office.CommandBarPopup
Dim ctlXYPopup As Office.CommandBarPopup
Dim ctlSub1 As Office.CommandBarButton
Dim ctlSub2 As Office.CommandBarButton
Dim ctlSub3 As Office.CommandBarButton
Dim ctlSub4 As Office.CommandBarButton

For lCount = 1 To 2

Set ctlToolsMenu =
Application.CommandBars(lCount).FindControl(, glMENU_TOOLS)

On Error Resume Next
''' Always attempt to delete any currently existing
instance of our menu that
''' might have been left hanging around by a crash.
ctlToolsMenu.Controls(gszMENU_APP).Delete
On Error GoTo 0

Set ctlXYPopup = ctlToolsMenu.Controls.Add(msoControlPopup)
'.... Other code

With objCommandBarButton
.Caption = "Perform Metrics Conversion..." (*)
.Style = msoButtonCaption
.Tag = "Perform Metrics Conversion..."
.OnAction = "!<Magic_Metrics.Connect"
.Visible = True
End With

Next lCount
End Sub

Thanks again everyone,
Jody

' Create a menu command on the "Tools" menu.
objCommandBars = Me.Application.CommandBars("Tools")
What is Me?? No matter.

Try one of these (I am omitting the "check if it already exists" portion
here, but you still need to do that)
Dim objCommandBar As CommandBar
Dim objCommandBarControl As CommandBarControl

Set objCommandBar = CommandBars("Tools")

'Add menu item to "Tools" menubar item
Set objCommandBarControl =
objCommandBar.Controls.Add(msoControlButton)
With objCommandBarButton
(etc)

Or (my prefered method):
Dim objCommandBar As CommandBar
Dim objCommandBarMenu As CommandBarControl
Dim objCommandBarControl As CommandBarControl

Set objCommandBar = CommandBars("Worksheet Menu Bar")
Set objCommandBarMenu = objCommandBar.Controls("Tools")

'Add menu item to "Tools" menubar item
Set objCommandBarControl =
objCommandBarMenu.Controls.Add(msoControlButton)
With objCommandBarButton
(etc)

For more information & examples:
Note that "Tools" also appears on the "Chart Menu Bar", which appears
instead of the WorksheetMenuBar when a Chart sheet is active.. If your app
has charts, and you need the Tools menu modified for both Worksheet or Chart
sheets, you need to modify *both* Menu Bars (simply set up a loop and change
the CommandBar name).

http://support.microsoft.com/default...b;en-us;830502
How to customize menus and menu bars in Excel

http://msdn.microsoft.com/library/de...ommandbars.asp
Working with Command Bars (Microsoft Office 2000/Visual Basic Programmer's
Guide)


HTH,
--
George Nicholson

Remove 'Junk' from return address.


"Jody L. Whitlock" wrote in message
...
This code is throwing nothing but errors in VBA:

Private WithEvents objCommandBarButton As CommandBarButton

Private Sub Workbook_Open()
Dim obkCommandbars As CommandBars
Dim objCommandBarMenu As CommandBar
Dim objCommandBarControl As CommandBarControl

' Create a menu command on the "Tools" menu.
objCommandBars = Me.Application.CommandBars("Tools")
objCommandBar = objCommandBars.Item("Tools")

' Make sure menu command doesn't already exist.
For Each objCommandBarControl In objCommandBar.Controls
If objCommandBarControl.Caption = "Perform Metric conversion..."
Then
objCommandBar.Controls.Item("Perform Metric
conversion...").Delete
End If
Next objCommandBarControl

objCommandBarButton = objCommandBar.Controls.Add(msoControlButton)

With objCommandBarButton
.Caption = "Perform Metrics Conversion..."
.Style = msoButtonCaption
.Tag = "Perform Metrics Conversion..."
.OnAction = "!<Magic_Metrics.Connect"
.Visible = True
End With
End Sub

AM I missing something here?

Jody W

Here's the final code I came up with, and it works very nicely. But
first, I want to thank everyone that posted, your comments and
suggestions led to things working in the end.

Imports Microsoft.Office.Interop.Excel

Public Class Calculate
Public Sub Perform(ByVal application As Application)
Try
application.Cursor = XlMousePointer.xlWait
application.StatusBar = "Calculating ..."

Dim Range1 As Microsoft.Office.Interop.Excel.Range
'Dim cell As Range
Dim PPS, PPH, IMAC, Netwrk, Srvr, Info, FAC, Account, SAP,
LicInst, Obr As Integer
Dim sTot As String

Dim Found As Boolean

' Init variables to 0 just in case
PPS = 0
PPH = 0
IMAC = 0
Netwrk = 0
Srvr = 0
Info = 0
FAC = 0
Account = 0
SAP = 0
LicInst = 0
Obr = 0

' Remember the cells the user selected before?
Range1 = application.Selection

'Check to see if the user selected anything, I'll use less
than 5 :-)
If Range1.Cells.Count < 5 Then Throw New Exception("You
must select a column to process")

' Set our variables
Dim nRows As Integer
Dim nCols As Integer
Dim regx As New System.Text.RegularExpressions.Regex("")

For nRows = 1 To Range1.Rows.Count
Dim s As String = Range1.Cells(nRows, 1).Value

If (Not s Is Nothing) Or (Not s = "") Then
' Find all SOFTWARE except SAP
If regx.IsMatch(s,
"\b(PPS|SOFTWARE)\b.(?!\b(SAP)\b)") Then PPS += 1
' Find all HARDWARE
If regx.IsMatch(s, "(\bPPH\b)|(\bHARDWARE\b)") Then
PPH += 1
' Find ONLY SAP
If regx.IsMatch(s, "(\bSAP\b)") Then SAP += 1
' Find ONLY IMAC
If regx.IsMatch(s,
"\b(PI|IMAC|PI[A-Z])\b.(?!\b(LIC)\b)") Then IMAC += 1
' Find O BACKUP/RESTORE
If regx.IsMatch(s, "\b(O)\b.*") Then Obr += 1
' Find NETWORK
If regx.IsMatch(s, "\b(N)\b.*") Then Netwrk += 1
' Find ACCOUNT
If regx.IsMatch(s, "\b(A)\b.*") Then Account += 1
' Find LIC INST
If regx.IsMatch(s, "\b(LIC)\b.(\b(INST)\b)") Then
LicInst += 1
' Find FACILITIES
If regx.IsMatch(s, "\b(FACILITIES)\b") Then FAC += 1
' Find INFO
If regx.IsMatch(s, "\b(INFO)\b") Then Info += 1
' Find all SERVER
If regx.IsMatch(s,
"((\bSP[A-Z]\b)|(\bS\b)|(\bS[A-Z]\b)|(\bSERVER\b))") Then Srvr += 1
End If

' Calculate the percentage complete
sTot = "Calculating " &
Decimal.Round(Decimal.Multiply(Decimal.Divide(CDec (nRows),
CDec(Range1.Rows.Count)), 100), 0) & "%"

' Solve "Flickering" problem in Status Bar
If Not application.StatusBar = sTot Then
application.StatusBar = sTot
Next

Dim ws As Worksheet
ws = application.Workbooks(1).Worksheets.Add()
ws.Name = "Results"

' Setup our labels
With ws
.Cells(1, 1).Value = "SOFTWARE"
.Cells(2, 1).Value = "HARDWARE"
.Cells(3, 1).Value = "IMAC"
.Cells(4, 1).Value = "SAP"
.Cells(5, 1).Value = "SERVER (SP)"
.Cells(6, 1).Value = "LIC INST"
.Cells(7, 1).Value = "ACCOUNT"
.Cells(8, 1).Value = "INFO"
.Cells(9, 1).Value = "BACKUP/RESTORE"
.Cells(10, 1).Value = "NETWORK"
.Cells(11, 1).Value = "FACILITIES"
.Cells(13, 1).Value = "Totals"
End With

ws.Range("A1:A13").Select()
With application.Selection
With .Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 14
End With
.Columns.Autofit()
End With

' Add our data
With ws
.Cells(1, 2).Value = PPS
.Cells(2, 2).Value = PPH
.Cells(3, 2).Value = IMAC
.Cells(4, 2).Value = SAP
.Cells(5, 2).Value = Srvr
.Cells(6, 2).Value = LicInst
.Cells(7, 2).Value = Account
.Cells(8, 2).Value = Info
.Cells(9, 2).Value = Obr
.Cells(10, 2).Value = Netwrk
.Cells(11, 2).Value = FAC
.Cells(13, 2).Value = PPS + PPH + Obr + SAP + Netwrk +
Account + LicInst + FAC + Info
End With

ws.Range("B1:B13").Select()
With application.Selection
With .Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 12
End With
.Columns.Autofit()
End With

ws.Activate()

Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Plugin Error")
Finally
application.Cursor = XlMousePointer.xlDefault
application.StatusBar = "Ready"
End Try
End Sub
End Class

The RegEx cuts out alot of Select Case/If Then code, which ended up
being 100+ lines of code.

I'm most likely going to write up an article and post it on CodeProject
so that others can use this as well.

Thank you all again,
Jody W