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

mawasw
mawasw used Ask the Experts™
on
Hello,

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()

TotCalc.Show

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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
gowflowPartner

Commented:
replace this
Sub CallOpenCalculator(control As IRibbonControl)

by this
Public Sub CallOpenCalculator(control As IRibbonControl)

gowflow
mawasw

Author

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?

Thanks,
M. Wilson
gowflowPartner

Commented:
well better attached your workbook to see what is happening
gowflow
Partner
Commented:
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.
gowflow
Calc.xlsm
mawasw

Author

Commented:
Thank you!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial