Search code examples
ms-accessvbams-access-2007ribbonfluent-interface

Use .png as custom ribbon icon in Access 2007


I'd like to use a .png as a custom icon in the Access 2007 ribbon.

Here's what I've tried so far:

I am able to load .bmp's and .jpg's as custom images without any problem. I can load .gif's, but it doesn't seem to preserve the transparency. I can't load .png's at all. I'd really like to use .png's to take advantage of the alpha-blending that is not available in the other formats.

I found a similar question on SO, but that just deals with loading custom icons of any kind. I am specifically interested in .png's. There is an answer from Albert Kallal to that question that links to a class module he had written that appears to do exactly what I want:

meRib("Button1").Picture = "HappyFace.png"

Unfortunately, the link in that answer is dead.

I also found this site which offers a download of a 460 line module full of dozens of API calls to get support for transparent icons. Before I go that route I wanted to ask the experts here if they know of a better way.

I know .png is pretty new-fangled and all, but I'm hoping the Office development folks slipped in some native support for the format.


Solution

  • Here is what I am currently using. Albert Kallal has a more full-fledged solution for Access 2007 ribbon programming that does a lot more than just load .png's. I am not using it yet, but it's worth checking out.

    For those who are interested, here is the code that I am using. I believe this is pretty close to the minimum required for .png support. If there's anything extraneous here, let me know and I'll update my answer.

    Add the following to a standard code module:

    Option Compare Database
    Option Explicit
    
    '================================================================================
    '  Declarations required to load .png's in Ribbon
    Private Type GUID
        Data1                   As Long
        Data2                   As Integer
        Data3                   As Integer
        Data4(0 To 7)           As Byte
    End Type
    
    Private Type PICTDESC
        Size                        As Long
        Type                        As Long
        hPic                        As Long
        hPal                        As Long
    End Type
    
    Private Type GdiplusStartupInput
        GdiplusVersion              As Long
        DebugEventCallback          As Long
        SuppressBackgroundThread    As Long
        SuppressExternalCodecs      As Long
    End Type
    
    Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, _
        inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
    Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, _
        hbmReturn As Long, ByVal background As Long) As Long
    Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
    Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, _
        RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
    '================================================================================
    
    Public Sub GetRibbonImage(ctl As IRibbonControl, ByRef image)
    Dim Path As String
        Path = Application.CurrentProject.Path & "\Icons\" & ctl.Tag
        Set image = LoadImage(Path)
    End Sub
    
    Private Function LoadImage(ByVal strFName As String) As IPicture
        Dim uGdiInput As GdiplusStartupInput
        Dim hGdiPlus As Long
        Dim hGdiImage As Long
        Dim hBitmap As Long
    
        uGdiInput.GdiplusVersion = 1
    
        If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
            If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
                GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
                Set LoadImage = ConvertToIPicture(hBitmap)
                GdipDisposeImage hGdiImage
            End If
            GdiplusShutdown hGdiPlus
        End If
    
    End Function
    
    Private Function ConvertToIPicture(ByVal hPic As Long) As IPicture
    
        Dim uPicInfo As PICTDESC
        Dim IID_IDispatch As GUID
        Dim IPic As IPicture
    
        Const PICTYPE_BITMAP = 1
    
        With IID_IDispatch
            .Data1 = &H7BF80980
            .Data2 = &HBF32
            .Data3 = &H101A
            .Data4(0) = &H8B
            .Data4(1) = &HBB
            .Data4(2) = &H0
            .Data4(3) = &HAA
            .Data4(4) = &H0
            .Data4(5) = &H30
            .Data4(6) = &HC
            .Data4(7) = &HAB
        End With
    
        With uPicInfo
            .Size = Len(uPicInfo)
            .Type = PICTYPE_BITMAP
            .hPic = hPic
            .hPal = 0
        End With
    
        OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
    
        Set ConvertToIPicture = IPic
    End Function
    

    Then, if you don't already have one, add a table named USysRibbons. (NOTE: Access treats this table as a system table, so you'll have to show those in your nav pane by going to Access Options --> Current Database --> Navigation Options and make sure 'Show System Objects' is checked.) Then add these attributes to your control tag:

    getImage="GetRibbonImage" tag="Acq.png"

    For example:

    <button id="MyButtonID" label="Do Something" enabled="true" size="large"
    getImage="GetRibbonImage" tag="MyIcon.png" onAction="MyPublicSub"/>