初心者備忘録

Webページ開設しました → 初心者備忘録: http://www.ka-net.org/

全体表示

[ リスト ]

前回の続きです。
前回はLoadPicture関数で読み込んだ画像をリボンのボタンに表示させました。LoadPicture関数は手軽に利用できるので便利なのですが、難点としては利用できる画像形式が少ないことです。特に背景を透過できるPNGが使用できないのは辛い…。
そこで今回はGDI+を利用してPNG画像も使用できるようにしてみました。
(といっても使用するFunctionは下記Webページのものをそのまま使うだけですが…)


【Office 2007】ボタンのイメージを外部から読み込む(2)
1. Office 2007ファイルを開き、標準モジュールに下記コードを貼り付けた後保存します。(今回はExcelファイル)
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 GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

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

Public 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

Public 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

Sub GetBtnImage(control As IRibbonControl, ByRef image)
  'イメージ読込
  Set image = LoadImage(ThisWorkbook.Path & "\image.png")
End Sub
Excel programming getImage and VBA Callbackより

※ 以降の手順は前回とほぼ同様なので、詳細は前回の記事を参照してください。

【関連記事】
ブログコンテンツ・リボンのカスタマイズ関連
http://blogs.yahoo.co.jp/kinuyo_asami/17750449.html

この記事に

閉じる コメント(0)

コメント投稿

顔アイコン

顔アイコン・表示画像の選択

名前パスワードブログ
絵文字
×
  • オリジナル
  • SoftBank1
  • SoftBank2
  • SoftBank3
  • SoftBank4
  • docomo1
  • docomo2
  • au1
  • au2
  • au3
  • au4
投稿

.


みんなの更新記事