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

' 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

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

Jody,
You just need to change the name of your command button.

In the code supplied by Bernie you are adding a Popup control that he
has called ctlXYPopup. So your with statement needs to reference that
control. Not the one you originally were trying to use
(objCommandBarButton).

Change the with statement to read

With ctlXYPopup

instead of

With objCommandBarButton

you also don't neet the following line in your with statement for the
Popup control

..Style = msoButtonCaption

HTH


--
bhofsetz
------------------------------------------------------------------------
bhofsetz's Profile: http://www.excelforum.com/member.php...o&userid=18807
View this thread: http://www.excelforum.com/showthread...hreadid=384613

bhofsetz wrote:


Jody,
You just need to change the name of your command button.

In the code supplied by Bernie you are adding a Popup control that he
has called ctlXYPopup. So your with statement needs to reference that
control. Not the one you originally were trying to use
(objCommandBarButton).

Change the with statement to read

With ctlXYPopup

instead of

With objCommandBarButton

you also don't neet the following line in your with statement for the
Popup control

.Style = msoButtonCaption

HTH

I cannot believe that doing this is proving more difficult then making
a multi-threaded TCP server with a database backend! This is just
crazy! Man, I think I'm going to pull out my hair and spit on my own
feet before this is over.
As one can tell from my ranting, it's still not working and I have no
clue why it isn't. Maybe more research? I've googled the hell outta
this and have come up empty handed, but will try again.

Thanks again everyone for all your help,
Jody

Jody,

Your .OnAction string also needs to be a valid macro name. What you have

..OnAction = "!<Magic_Metrics.Connect"

is not allowed in Excel land. (Excel doesn't like the <'s in a macro name)

HTH,
Bernie
MS Excel MVP



I cannot believe that doing this is proving more difficult then making
a multi-threaded TCP server with a database backend! This is just
crazy! Man, I think I'm going to pull out my hair and spit on my own
feet before this is over.
As one can tell from my ranting, it's still not working and I have no
clue why it isn't. Maybe more research? I've googled the hell outta
this and have come up empty handed, but will try again.

Thanks again everyone for all your help,
Jody

Jody,
What error are you getting now and on what line does it give you
the error?


--
bhofsetz
------------------------------------------------------------------------
bhofsetz's Profile: http://www.excelforum.com/member.php...o&userid=18807
View this thread: http://www.excelforum.com/showthread...hreadid=384613

bhofsetz wrote:


Jody,
What error are you getting now and on what line does it give you
the error?

Here's what I have come up with and works:

Public Sub Create_Menu()

Delete_Menu()

MenuObject =
applicationObject.CommandBars(1).Controls.Add(Type :=Office.MsoControlTyp
e.msoControlPopup, Befo=10)
MenuObject.Caption = "Ma&gic Metrics"

MyButton =
MenuObject.Controls.Add(Type:=Office.MsoControlTyp e.msoControlButton,
Temporary:=True)

With MyButton
.Caption = "Calculate Metrics"
.Visible = True
End With

End Sub
Public Sub Delete_Menu()
Try
applicationObject.CommandBars(1).Controls("Ma&gic
Metrics").Delete()
Catch ex As Exception
End Try
End Sub

Now, this is in VB.NET 2003, so I feel a little more warm and fuzzy in
life, but have generated myself a new problem. The reason for VB.NET?
RegEX! Otherwise, I have about 300 Select statements to write, I've
gotten about 1/3 of them done...
Anyhew, hopefully I will be able to figure out my new problem LOL

Thanks again, my solution was a colmunation of everything said in this
thread...

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