Dynamic Ribbon Menu fails when another workbook is opened

MarkCBB

Active Member
Joined
Apr 12, 2010
Messages
497
Hi there,

In short I have an Add-In that has a Dynamic Menu, Dynamic because it populated a list from a range in the Add-In workbook.
The code runs as it should if the range already exists in the Add-In workbook, my challenge is when I populate that range from another workbook. (No error code appears)

code steps. click dynamic ribbon button, open a file, copy range, paste into add-In workbook, populate the dynamic list with GetContent. at this point the list work populate, I have a feeling the Ribbon, or the control loses it content when the other workbook is opened.

This is the code that works:

HTML:
Sub GetSiteFileList(control As IRibbonControl, ByRef returnedVal)
Dim xml As String
Dim myText As String
Dim I As Long
Dim cell As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False
If ThisWorkbook.Sheets("VENDOR_LIST").Range("A1").Value = "" Then Call GetSiteFileList_01
Application.DisplayAlerts = True
Application.ScreenUpdating = True

I = 1
xml = ""
    
For Each cell In ThisWorkbook.Sheets("VENDOR_LIST").Range("A2:A1000")
If cell.Value = "" Then Exit For
    If myText = "" Then
        myText = "<button id=""buts" & I & """ imageMso=""FindDialog"" label=""" & cell.Offset(0, 1).Value & " " & cell.Offset(0, 2).Value & cell.Offset(0, 3).Value & """ onAction=""" & cell.Offset(0, 0).Value & "_" & cell.Offset(0, 1).Value & cell.Offset(0, 2).Value & """/>"
    Else
        myText = myText & "<button id=""buts" & I & """ imageMso=""FindDialog"" label=""" & cell.Offset(0, 1).Value & " " & cell.Offset(0, 2).Value & cell.Offset(0, 3).Value & """ onAction=""" & cell.Offset(0, 0).Value & "_" & cell.Offset(0, 1).Value & cell.Offset(0, 2).Value & """/>"
    End If
    I = I + 1
Next cell
              
xml = "<menu xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">" & myText & "</menu>"
returnedVal = xml
I = 0

End Sub

this code does not work, note the call code has been added to the same code that is above, and the other code is below:

HTML:
Sub GetSiteFileList(control As IRibbonControl, ByRef returnedVal)
Dim xml As String
Dim myText As String
Dim I As Long
Dim cell As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Call GetSiteFileList_01 ' New code is here, this called the code to get the workbook data and add it into the Add-In workbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True

I = 1
xml = ""
    
For Each cell In ThisWorkbook.Sheets("VENDOR_LIST").Range("A2:A1000")
If cell.Value = "" Then Exit For
    If myText = "" Then
        myText = "<button id=""buts" & I & """ imageMso=""FindDialog"" label=""" & cell.Offset(0, 1).Value & " " & cell.Offset(0, 2).Value & cell.Offset(0, 3).Value & """ onAction=""" & cell.Offset(0, 0).Value & "_" & cell.Offset(0, 1).Value & cell.Offset(0, 2).Value & """/>"
    Else
        myText = myText & "<button id=""buts" & I & """ imageMso=""FindDialog"" label=""" & cell.Offset(0, 1).Value & " " & cell.Offset(0, 2).Value & cell.Offset(0, 3).Value & """ onAction=""" & cell.Offset(0, 0).Value & "_" & cell.Offset(0, 1).Value & cell.Offset(0, 2).Value & """/>"
    End If
    I = I + 1
Next cell
              
xml = "<menu xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">" & myText & "</menu>"
returnedVal = xml
I = 0

End Sub

Sub GetSiteFileList_01()
Dim wb_VedorList As Workbook

'Check to see if The File Exists
If Len(Dir(ThisWorkbook.Sheets("AccessControl").Range("B17").Value)) = 0 Then
    MsgBox ("No Master File for " & cmb_VendorList.Value & " was found. This Means there there is not folder or file for the Vendor, Please contact Admin")
    str_ErrorEmailMessage = "User Name: " & Application.UserName & vbNewLine & vbNewLine & "Tried to open a file for: " & cmb_VendorList.Value & vbNewLine & " But no file or folder was found. Please check to see if this is a new client or if the file is missing"
    ThisWorkbook.Sheets("ComTemplate").Range("A1").Value = str_ErrorEmailMessage
    Call SendErrorEmailMessage
    Exit Sub
End If
Application.ScreenUpdating = False
Set wb_VedorList = Workbooks.Open(ThisWorkbook.Sheets("AccessControl").Range("B17").Value)
wb_VedorList.Sheets(1).Range("A1").CurrentRegion.Copy
ThisWorkbook.Sheets("VENDOR_LIST").Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
wb_VedorList.Close False
Application.ScreenUpdating = True
End Sub


It there a way to get this done? the only way I can get it to work is to have a button called "Load me data" click that and then run the first bit of code. but not keen on doing that. 1 click is better than 2 clicks.

I really look forward to any suggestions.

Kindest Regards,
Mark B
 
Last edited by a moderator:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

Forum statistics

Threads
1,215,487
Messages
6,125,079
Members
449,205
Latest member
Healthydogs

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top