Excel - Open a UserForm from a Custom Ribbon button with ribbonxml


Here is my code  

Option Explicit

Private Sub Workbook_Activate()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI      xmlns:mso='http://schemas.microsoft.com/office/2009/07/customui'>" & vbNewLine
ribbonXML = ribbonXML + "  <mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:qat/>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "      <mso:tab id='reportTab' label='WBG' insertBeforeQ='mso:TabFormat'>" & vbNewLine
ribbonXML = ribbonXML + "        <mso:group id='reportGroup' label='Total Calculator' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='runReport' " & vbNewLine
ribbonXML = ribbonXML + "            imageMso='Calculator'      onAction='CallOpenCalculator'/>" & vbNewLine
ribbonXML = ribbonXML + "        </mso:group>" & vbNewLine
ribbonXML = ribbonXML + "      </mso:tab>" & vbNewLine
ribbonXML = ribbonXML + "    </mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "  </mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "</mso:customUI>"

ribbonXML = Replace(ribbonXML, """", "")

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

Option Explicit

Sub CallOpenCalculator(control As IRibbonControl)

    Call OpenCalc
End Sub
Sub OpenCalc()


End Sub

Problem - When I click the custom button on the ribbon, the TotCalc form is not displayed.  Instead, I receive a message stating "....The macro may not be available in this workbook or all macros may be disabled."

Please help.

M. Wilson
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

replace this
Sub CallOpenCalculator(control As IRibbonControl)

by this
Public Sub CallOpenCalculator(control As IRibbonControl)

mawaswAuthor Commented:
Thank you for the feedback.

I now receive a message stating "Argument not optional"

Here is where I call CallOpenCalculator.......imageMso='Calculator'      onAction='CallOpenCalculator'/......

Do I need to pass it something?

M. Wilson
well better attached your workbook to see what is happening
ok I figured it out. Sorry my mistake you had posted the code in your question !!! shame on me.

Anyhow I looked up your code and there was some small flop that prevented the calculator to come up. The part under Thisworkbook is fine, however after your second 'Option Explicit' this code should be in a Module and differently written like herebelow:

Option Explicit

Sub CallOpenCalculator()
Dim Program As String, TaskID As Double
Program = "calc.exe"
On Error Resume Next
AppActivate "Calculator"

If Err <> 0 Then
    Err = 0
    TaskID = Shell(Program, 1)
    If Err <> 0 Then MsgBox "Can't start " & Program, vbCritical, "Calculator"
End If

End Sub

Open in new window

Anyway, I have attached the workbook with the code simply do the following before running to ensure success:
1) If you had previously run this code on your pc then goto C:\Users\'Your Username'\AppData\Local\Microsoft\OFFICE and locate the file: Excel.officeUI and delete it.
2) Open this file the first time and enable macros.
3) Close the file and save it (so it register the macro and save the file in your pc.
4) Now run the workbook again and open the Menu WBG and there you have the calculator click on the Icon and it should work.

Please note that this will enable this menu on any of your workbooks that you launch beside this one however the macro will only work on this one as the code reside in it.

Let me know if it works for you.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mawaswAuthor Commented:
Thank you!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.