No, not in data validation or any drop-down object for that matter. Photos would need to be housed in a shape (example comment) or Image control or on the worksheet itself, but not within any drop-down lists which are only meant for text.
This is a discussion on Add pictures to drop down menu within the Excel Questions forums, part of the Question Forums category; I m creating a custom drop down menu using data validation, i just wanted to know if it is possible ...
I m creating a custom drop down menu using data validation, i just wanted to know if it is possible to add pictures in drop down menu
Actually, you can use some Common Windows Controls like Treview,ImageList...to display an Image next to the Text which can enhance the UI very nicely.
The other Good news is that these Controls are installed with any MS Office which means that there is no need to copy the Control file together with the Application as would otherwise be the case with other third parties Controls.
Anyway, here is an example I came up with which uses an ImageComboBox Control, and Three CommandButtons.
1) Insert a ImageCombo1 on Sheet1
(To get the ImageCombo1, Click on the MoreControls Icon on the Controls ToolBar and Select " Microsoft ImageComboBox Control "
2) Create thre Buttons from the Forms ToolBar and assign to them the Routines as follows :
- Button1 ==> Procedure : PopulateCombo
- Button2 ==> Procedure : ChangeCursor
- Button3 ==> Procedure : RestoreDefault
When you click Button1, the ComboBox gets populated by all the Cursors that exist in the System. (*.cur)
When you click on Button2, the System Cursor changes to the one that is selected on the ComboBox.
When Button3 is clicked , the Default Win Cursor is restored.
Code to be placed in a Standard Module :
By displaying the actual Cursor Images, the user can better decide which cursor they want because they can conviniently see it.Code:Private Declare Function LoadCursorFromFile Lib "user32" Alias _ "LoadCursorFromFileA" (ByVal lpFileName As String) As Long Private Declare Function SetSystemCursor Lib "user32" _ (ByVal hcur As Long, ByVal id As Long) As Long Const OCR_NORMAL As Long = 32512 Sub PopulateCombo() Dim intI As Integer Dim objImgCmb As ImageCombo Dim objTempImgList As New ImageList Set objTempImgList = GetIcons("C:\WINDOWS\Cursors") '\\ This assumes the Combo name is the Def 'ImageCombo1' '\\ and is Embeeded in Sheet1 .Change these as required With Sheet1.ImageCombo1 '\\Clear Combo just in case .ComboItems.Clear '\\ Transfer images to the Combo ImageList Property Set .ImageList = objTempImgList For intI = 1 To objTempImgList.ListImages.Count .ComboItems.Add , , _ objTempImgList.ListImages(intI).Key, intI Next intI '\\ Format the Combo so it displays Text & Imgs Set .SelectedItem = .ComboItems(1) .ForeColor = vbRed .Font.Bold = True .Width = 250 End With '\\ Clean up Set objImgCmb = Nothing Set objTempImgList = Nothing End Sub Sub ChangeCursor() '\\ Load Selected Curs With Sheet1.ImageCombo1 GetSpecialCursor .SelectedItem End With End Sub Sub GetSpecialCursor(ByVal ChngCursor As String) Dim lngNewCurs As Long lngNewCurs = LoadCursorFromFile(ChngCursor) SetSystemCursor lngNewCurs, OCR_NORMAL End Sub Function GetIcons(strCursorFolder As String) As ImageList '\\ Declare var to hold Curs Pictures Dim objImgList As New ImageList Dim curs As Variant '\\ Search Win\Cur..for Curs Files With Application.FileSearch .NewSearch .LookIn = strCursorFolder .Filename = ".cur" .SearchSubFolders = False If .Execute() > 0 Then For Each curs In .FoundFiles '\\ Store curs Icons in the ImageList objImgList.ListImages.Add _ Key:=curs, Picture:=LoadPicture(curs) Next End If If .FoundFiles.Count = 0 Then MsgBox "No (*.Cur) files found in ( " & strCursorFolder _ & " )" & vbCrLf & "Try another folder.", vbCritical: End End If End With '\\ Clean Up Set GetIcons = objImgList Set objImgList = Nothing End Function Sub RestoreDefault() '\\Run this if you want to restore Default Sys Cursor GetSpecialCursor ("C:\WINDOWS\Cursors\arrow_m.cur") End Sub
After playing with your code I now have an oversized cursor.
And yes I did run the routine to restore the default.
If posting code please use code tags.
Hello Jaafar - -
Actually you and I agree on this, because my point was that everyday drop-downs (I did not say "everyday" drop-downs but mentioned common ones like data validation and comboboxes) do not support this property, whereas other shapes (comments, buttons, etc) and controls (Image) do support the property, the latter of which your suggestion might fall, though I should not have sounded so definitive with my "no" answer.
Speaking of, I have never used the ImageCombo control and did not think to suggest it as an alternative, thanks for that, you always have some interesting solutions to offer and I enjoy adding them to my library.
Did your code really work for you? I get an error in the GetIcons function with the LoadPicture argument. I would like to see this work. The other thing on my mind is, 99.99% of all Excel work I do is for my clients, not for me, so I need to make sure their graphic Image is included somewhere in the file itself (can't count on it always being in an accessible path for all users of the app), so the cbo can find it and display it. In actual practice, the images would likely be pictures or custom graphics associated with the client.
Just restore the Default Cursor via Control Pannel and try to adapt this Code I found onhttp://<a href="http://www.mentalis....rsor.shtml</a>Website.
This should recover your initial Cursor becuse it stores it in a Global variable before changing it.Code:'Code by Jerry Grant (Jerry@jg-design.net) 'Visit his website at http://www.jg-design.net 'This example requires two command buttons Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long Private Declare Function GetCursor Lib "user32" () As Long Private Const OCR_NORMAL As Long = 32512 Private currenthcurs As Long Private tempcurs As Long Private newhcurs As Long Private Sub Command1_Click() Dim myDir As String Dim lDir As Long myDir = Space(255) currenthcurs = GetCursor() tempcurs = CopyIcon(currenthcurs) lDir = GetWindowsDirectory(myDir, 255) myDir = Left$(myDir, lDir) & "\cursors\banana.ani" newhcurs = LoadCursorFromFile(myDir) Call SetSystemCursor(newhcurs, OCR_NORMAL) End Sub Private Sub Command2_Click() Call SetSystemCursor(tempcurs, OCR_NORMAL) End Sub
For some strange reason, in some systems like mine, the above Code doesn't work . ie , the Initial Cursor is not Restored !!!! That's why I had to hardCode it : GetSpecialCursor ("C:\WINDOWS\Cursors\arrow_m.cur")
I am not sure why you get an error but I suspect it could be because of the folder Path. The code works well in my computer.
As you rightly said, there is no garanty that the User's computer folders\files will be the same. Would work if hardcoded though.