Results 1 to 7 of 7

Add pictures to drop down menu

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 ...

  1. #1
    New Member
    Join Date
    Aug 2005
    Posts
    1

    Default Add pictures to drop down menu

    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

  2. #2
    MrExcel MVP Tom Urtis's Avatar
    Join Date
    Feb 2002
    Location
    San Francisco, California USA
    Posts
    11,008

    Default

    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.

  3. #3
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,965

    Default

    Hello Tom,

    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 :


    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
    By displaying the actual Cursor Images, the user can better decide which cursor they want because they can conviniently see it.


    Regards.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  4. #4
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling
    Posts
    65,969

    Default

    Jaafar

    Thanks.

    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.

  5. #5
    MrExcel MVP Tom Urtis's Avatar
    Join Date
    Feb 2002
    Location
    San Francisco, California USA
    Posts
    11,008

    Default

    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.

    Thanks.

  6. #6
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,965

    Default

    Norie,

    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.

    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
    This should recover your initial Cursor becuse it stores it in a Global variable before changing it.

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

    Regards.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  7. #7
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,965

    Default

    Hi Tom,

    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.

    Regards.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com