• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Creating a cutom gallery button

S

scottj

New Member
Hi all,


I've used some code I found on MSDN to create a custom gallery with a number different buttons using pics that i've stored in a folder.


I'm trying to modify the code to create a secondary button but I just can't seem to get it to work.


Any help would be much appreciated!!


The code is; http://msdn.microsoft.com/en-us/library/dd756403.aspx


Scott.
 
Hi, scottj!

There are several pieces of code in that link. Making things easier, can you upload a file with the workbook?

Regards!
 
The XML I'm using is;

[pre]
Code: 
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false"> <tabs> <tab id="rxtab" insertBeforeMso="TabHome" label="Flashings"> <group id="rxgrp" label="Pitched Roof">

<!-- Starts the definition of our gallery.-->
<gallery id="rxgal" label="Box Gutters" columns="3" rows="10" itemWidth="200" itemHeight="150" getImage="rxgal_getImage" getItemCount="rxgal_getItemCount" getItemImage="rxgal_getItemImage" getItemScreentip="rxgal_getItemScreentip" onAction="rxgal_Click" showItemLabel="false" size="large"> 

<gallery id="Capgal" label="Cappings" columns="3" rows="10" itemWidth="200" itemHeight="150" getImage="Capgal_getImage" getItemCount="Capgal_getItemCount" getItemImage="Capgal_getItemImage" getItemScreentip="Capgal_getItemScreentip" onAction="Capgal_Click" showItemLabel="false" size="large">
<!-- Insert a button at the end of the gallery.--> <button id="rxbtn" imageMso="RefreshStatus" label="Visit Office Online..." onAction="rxbtn_Click"/> </gallery> </group> </tab> </tabs> </ribbon> </customUI>
[/pre]

sorry about the lack of formatting.

The VBA script is;
Dim MyFiles() As String
Dim Fnum As Long

Sub rxgal_getImage(control As IRibbonControl, ByRef returnedVal)
Dim FilesInPath As String
FilesInPath = Dir(ThisWorkbook.Path & "Img*.jpg")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

Set returnedVal = LoadPicture(ThisWorkbook.Path & "Img" & MyFiles(Fnum))

End Sub
Sub Capgal_getImage(control As IRibbonControl, ByRef returnedVal)
Dim FilesInPath As String
FilesInPath = Dir(ThisWorkbook.Path & "Img*.jpg")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

Set returnedVal = LoadPicture(ThisWorkbook.Path & "Img" & MyFiles(Fnum))

End Sub

Sub rxgal_getItemCount(control As IRibbonControl, ByRef returnedVal)
returnedVal = Fnum - 1
End Sub
Sub Capgal_getItemCount(control As IRibbonControl, ByRef returnedVal)
returnedVal = Fnum - 1
End Sub

Sub rxgal_getItemScreentip(control As IRibbonControl, index As Integer, ByRef returnedVal)
'This callback runs for every item(label).

'Use this if you want to use the cell values of "B1:B12" on Sheet2 for screen tips.
' returnedVal = Sheets("Sheet2").Cells(index + 1, 2).Value

'This example will use the values in the array for screen tips.
Dim Tipname As Variant
Tipname = _
Array("Tip 1", _
"Tip 2", _
"Tip 3", _
"Tip 4", _
"Tip 5", _
"Tip 6", _
"Tip 7", _
"Tip 8", _
"Tip 9", _
"Tip 10", _
"Tip 11", _
"Tip 12")

On Error Resume Next
returnedVal = Tipname(index)
On Error GoTo 0
End Sub
Sub Capgal_getItemScreentip(control As IRibbonControl, index As Integer, ByRef returnedVal)
'This callback runs for every item(label).

'Use this if you want to use the cell values of "B1:B12" on Sheet2 for screen tips.
' returnedVal = Sheets("Sheet2").Cells(index + 1, 2).Value

'This example will use the values in the array for screen tips.
Dim Tipname As Variant
Tipname = _
Array("Tip 1", _
"Tip 2", _
"Tip 3", _
"Tip 4", _
"Tip 5", _
"Tip 6", _
"Tip 7", _
"Tip 8", _
"Tip 9", _
"Tip 10", _
"Tip 11", _
"Tip 12")

On Error Resume Next
returnedVal = Tipname(index)
On Error GoTo 0
End Sub

Sub rxgal_Click(control As IRibbonControl, id As String, index As Integer)
'Call the macro that belongs to the label when you click one of the labels.
'Example: When you click the first label it runs the macro named "macro_1".
On Error Resume Next
Application.Run "macro_" & Format(index + 1, "00")
On Error GoTo 0
End Sub
Sub Capgal_Click(control As IRibbonControl, id As String, index As Integer)
'Call the macro that belongs to the label when you click one of the labels.
'Example: When you click the first label it runs the macro named "macro_1".
On Error Resume Next
Application.Run "macro_" & Format(index + 1, "00")
On Error GoTo 0
End Sub

Sub macro_01()
MsgBox "Macro 1"
End Sub
Sub macro_02()
MsgBox "Macro 2"
End Sub
Sub macro_03()
MsgBox "Macro 3"
End Sub
Sub macro_12()
MsgBox "Macro 12"
End Sub

Sub rxbtn_Click(control As IRibbonControl)
'This code will run when you click on the button at the bottom of the Gallery
ActiveWorkbook.FollowHyperlink "http://www.rondebruin.nl/tips.htm"
End Sub
Sub Capbtn_Click(control As IRibbonControl)
'This code will run when you click on the button at the bottom of the Gallery
ActiveWorkbook.FollowHyperlink "http://www.rondebruin.nl/tips.htm"
End Sub

Sub rxgal_getItemImage(control As IRibbonControl, index As Integer, ByRef returnedVal)
Set returnedVal = LoadPicture(ThisWorkbook.Path & "Img" & MyFiles(index + 1))
End Sub

Sub Capgal_getItemImage(control As IRibbonControl, index As Integer, ByRef returnedVal)
Set returnedVal = LoadPicture(ThisWorkbook.Path & "Img" & MyFiles(index + 1))
End Sub
If I only have the rxgal items, then the gallery works perfectly, its when I try to add the additional gallery (Capgal) that I have problems. (Both buttons don't show at all)

I'm hoping you can make sense of all of this. Is there a way I can upload the workbook to make it easier?
 
Hi, scottj!

In the forums main page, this second sticky topic links to the indications for uploading files.

http://chandoo.org/forums/topic/posting-a-sample-workbook

Regards!
 
5407999.png


Finding the best image suited for a custom control is not that easy, as there are about 4,000 unique icons in Office 2013.

This free-UNLOCKED Excel VBA Add-in uses the Ribbon Commander framework to display dynamically built-in imageMSO icons or imported images in Excel's Ribbon (in buttons or gallery items). What you see, is what you get in your Ribbon !

The imageMSO or any image list can be filtered using with a description keyword search or can be browsed sequentially in a ribbon gallery.

The descriptions of any buttons clicked are saved in a list, which can be exported for use with the Custom UI editor or re-imported to the Add-in for viewing.


See more at: http://www.spreadsheet1.com/dynamic-icon-browser.html
 
You must log in or register to reply here.
Back
Top