Excel2007のVBAでリボンのアイコンにファイルから読み込まずに白色のBitmap画像を表示したい。

Question

はじめまして、よろしくお願いいたします。
Web上のサンプルなどを参照したのですが、うまくいかなかったので、質問させてください。

まず仕様なのですが、
①Excel2007のVBAでリボンのアイコンに白色のBitmap画像を表示したい。(VSTOは、持っていません。)
②Bitmap画像は、ファイルやフォームに保存してあるBitmap画像を使用するのではなく、メモリ上にBitmap画像を作成して、表示させたい。ワークシート上に保存してある場合は可能。
→理由は、配布しやすいように、Excelマクロファイル本体のみにしたいため。
以上のようなのもを作ろうと思っています。

次に、今回テストしたソースコードを示します。
(参照したソースコードは、
①「初心者備忘録」[http://www.ka-net.org/ribbon/ri27.html]のページ
②「Ribbon」[http://homepage2.nifty.com/suyamsoft/Ribbon/]
③書籍「Excel VBAによるWin32 API プログラミング入門」/大村あつし著
を参照させていただきました。)

このソースコードでは、CreateBitmap関数でメモリ上にBitmap画像を作成して、表示させようとしていますが、画像の色が、白色ではなく、黒色になってしまいます。

===============================================================================
ThisWorkbook
-------------------------------------------------------------------------------
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Call DeleteObject(hBitmap)
    
End Sub

===============================================================================
MainModule
-------------------------------------------------------------------------------
Option Explicit

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

Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, lpiid As Any) As Long
Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As Long, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits() As Any) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function SetErrorMode Lib "kernel32" (ByVal wMode As Long) As Long
Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Const SEM_FAILCRITICALERRORS = &H1&

Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200&
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000&

Const IID_IPictureDisp As String = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

Public hBitmap As Long

Dim myRibbon As IRibbonUI

Private Function ConvertToIPicture(ByVal hPic As Long, ByVal PICTYPE_TYPE_NUM As Long, ByVal IID_KIND As String) As IPicture
    
    Dim IID(0 To 3) As Long
    Dim IPic As IPicture
    Dim uPicInfo As PICTDESC
    
    With uPicInfo
        .Size = Len(uPicInfo)
        .Type = PICTYPE_TYPE_NUM
        .hPic = hPic
        .hPal = 0&
    End With
    
    Call IIDFromString(StrPtr(IID_KIND), IID(0))
    Call OleCreatePictureIndirect(uPicInfo, IID(0), True, IPic)
    Set ConvertToIPicture = IPic
    
End Function

Function LoadImage() As IPicture
    
    Dim strBuffer As String * 1024
    Dim rc As Long
    
    Dim uGdiInput As GdiplusStartupInput
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim PICTYPE_TYPE_NUM As Long
    
    Dim nWidth As Long
    Dim nHeight As Long
    Dim cPlanes As Long
    Dim nBitCount As Long
    Dim lpBits(0) As Byte
    
    ' 1 × 1 のBitmapを指定
    nWidth = 0
    nHeight = 0
    cPlanes = 1
    nBitCount = 1
    
    ' 白色を指定している
    lpBits(0) = &HFF
    
    PICTYPE_TYPE_NUM = 1  ' bit map
    
    'OSによるエラー処理を抑止して呼び出し側のプロセスにエラーを送る
    rc = SetErrorMode(SEM_FAILCRITICALERRORS)
    
    uGdiInput.GdiplusVersion = 1&
    
    If GdiplusStartup(hGdiPlus, uGdiInput) = 0& Then
        hBitmap = CreateBitmap(nWidth, nHeight, cPlanes, nBitCount, lpBits)
        
        'エラーが発生
        rc = FormatMessage(FORMAT_MESSAGE_IGNORE_INSERTS Or _
                            FORMAT_MESSAGE_FROM_SYSTEM, _
                            ByVal vbNullString, _
                            Err.LastDllError, _
                            0&, _
                            strBuffer, _
                            Len(strBuffer), _
                            0&)
        MsgBox _
        Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
        
        MsgBox hBitmap
        Set LoadImage = ConvertToIPicture(hBitmap, PICTYPE_TYPE_NUM, IID_IPictureDisp)
        Call GdipDisposeImage(hGdiImage)
        Call GdiplusShutdown(hGdiPlus)
    End If
    
    'エラーの処理モードを既定に設定
    rc = SetErrorMode(0&)
    
End Function

Sub OnLoad(ribbon As IRibbonUI)
	
    Set myRibbon = ribbon
    myRibbon.Invalidate
    
End Sub

Sub GetImage(control As IRibbonControl, ByRef image)

    Dim strBuffer As String * 1024
    Dim rc As Long
    
    'OSによるエラー処理を抑止して呼び出し側のプロセスにエラーを送る
    rc = SetErrorMode(SEM_FAILCRITICALERRORS)
    
    Set image = LoadImage()
    
    'エラーが発生
    rc = FormatMessage(FORMAT_MESSAGE_IGNORE_INSERTS Or _
                        FORMAT_MESSAGE_FROM_SYSTEM, _
                        ByVal vbNullString, _
                        Err.LastDllError, _
                        0&, _
                        strBuffer, _
                        Len(strBuffer), _
                        0&)
    MsgBox _
    Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    
    'エラーの処理モードを既定に設定
    rc = SetErrorMode(0&)
    
End Sub

Sub OnAction(control As IRibbonControl)
    MsgBox "OK!"
End Sub

===============================================================================

 

===============================================================================
Ribbon.xml
-------------------------------------------------------------------------------
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="OnLoad">
	<ribbon startFromScratch="false">
		<tabs>
			<tab id="customTab" label="Custom Tab" insertBeforeMso="TabHome">
				<group id="customGroup" label="Custom Group">
					<button id="myButton" label="My Button" getImage="GetImage" size="large" onAction="OnAction" />
				</group>
			</tab>
		</tabs>
	</ribbon>
</customUI>

===============================================================================

以上、大変恐縮ですが、どうかご協力をお願いいたします。