Office 圖標精美漂亮，作爲微軟的官方圖標，與 Windows 具有一致的風格，但我們若想把這些圖標用在自己的程序中，卻並不容易，使用常規的提取程序資源的方法，根本得不到這些圖標。
微軟雖然沒有把這些圖標開放給我們下載使用，但在 Office VBA 中，微軟卻是允許我們隨意使用的。通過調用 CommandBars.GetImageMso 方法，我們可以得到指定控件的圖標。
CommandBars.GetImageMso 方法的第一個參數，要求提供控件的標識符。那麼我們怎麼知道 Office 中有哪些控件，標識符又是什麼呢？在這方面，微軟做的還是非常好的，Office Fluent UI Command Identifiers (https://github.com/OfficeDev/office-fluent-ui-command-identifiers)，在這個網址，微軟提供了 Office 所有控件的標識符。
本篇文章中，我們將新建一個 Excel 文件，並創建一個用戶窗體，在用戶窗體上顯示一些帶圖標的按鈕，點擊按鈕即可將按鈕上的圖標導出到 PNG 文件。
創建窗體
在窗體上擺放 500 個按鈕，用於顯示圖標。由於圖標較多，有幾千個，再在窗體上放一個 TabStrip，用於切換顯示的圖標。
Private Sub AddControls()
Set tabStrip1 = Me.Controls.Add("Forms.TabStrip.1", "tabStrip1", True)
With tabStrip1
.Left = 0
.Top = 0
.Width = 860
.Height = 705
End With
tabStrip1.Tabs(0).Caption = "1-500"
tabStrip1.Tabs(1).Caption = "501-1000"
Dim num As Integer
For num = 1000 To 7000 Step 500
tabStrip1.Tabs.Add "Forms.Tab." & (tabStrip1.Tabs.Count + 1), (num + 1) & "-" & (num + 500)
Next num
Set CheckBox1 = Me.Controls.Add("Forms.CheckBox.1", "checkBox1", True)
With CheckBox1
.Caption = "大圖標"
.Left = 800
.Top = 0
.Width = 45
.Height = 15
.Value = True
End With
Dim CmdBtn As MSForms.CommandButton
Dim rows As Integer
Dim cols As Integer
For rows = 1 To 20
For cols = 1 To 25
Set CmdBtn = Me.Controls.Add("Forms.CommandButton.1", "commandButton" & rows & cols)
With CmdBtn
.Name = "image" & ((rows - 1) * 25 + cols)
.Left = 5 + 34 * (cols - 1)
.Top = 18 + 34 * (rows - 1)
.Width = 34
.Height = 34
.PicturePosition = fmPicturePositionCenter
End With
Next cols
Next rows
End Sub
顯示圖標
獲取 Office 圖標的唯一方法 CommandBars.GetImageMso，用這個方法得到圖標後，賦值給按鈕的 Picture 屬性。
Private Sub ShowImages()
On Error Resume Next
Dim idx As Integer, imgIdx As Integer
Dim btn As MSForms.CommandButton
Dim pic As IPictureDisp
Dim ImgSize As Long
If CheckBox1.Value = True Then ImgSize = 32 Else ImgSize = 16
For idx = 1 To 500
imgIdx = idx + 500 * tabStrip1.Value
Set btn = Me.Controls.Item("image" & idx)
If imgIdx <= 7345 Then
Set pic = Nothing
Set pic = Application.CommandBars.GetImageMso(Replace(Range("A" & imgIdx).Value, Chr(34), ""), ImgSize, ImgSize)
With btn
.Visible = True
.Caption = ""
.Picture = pic
.ControlTipText = imgIdx & "-" & Replace(Range("A" & imgIdx).Value, Chr(34), "")
End With
Else
btn.Visible = False
End If
Next idx
End Sub
導出圖標
要把圖標導出到 PNG 文件，首先想到的就是使用 GDI+。GDI 不能處理 PNG 格式，可用 GDI+ 的 GdipCreateBitmapFromHBITMAP 函數把 StdPicture 轉換成 GDI+ 的 Bitmap，然後再用 GdipSaveImageToFile 函數保存到 PNG 格式文件。
圖樣圖森破，用這個方法雖然確實導出了 PNG 圖片，但導出的 PNG 圖片背景是白色的，這並不是我想要的結果，我希望導出的是背景透明的 PNG 圖片。
試錯
背景不透明，毫無疑問是 Alpha 值的問題。所以首先就想到，把轉換來的 GDI+ 的 Bitmap 的 Alpha 值，根據原始圖片的 Alpha 值重新設置一遍，然後再保存。具體思路是：
- 使用
GetDIBits函數，獲得通過GetImageMso得到的 StdPicture 的原始數據 - 使用
GdipBitmapGetPixel函數取得 GDI+ 的 Bitmap 的每個像素值 - 根據原始數據，修改每個像素的 Alpha 值
- 使用
GdipBitmapSetPixel函數，把修改 Alpha 後的像素值寫回 Bitmap - 保存成 PNG 圖片
經過實踐，發現執行 GdipBitmapSetPixel 函數後，各個像素的 Alpha 值並沒有改變，導出的圖片仍然是白色背景。
再試錯
接着上面的思路，既然單獨修改 Alpha 值不好用，那麼幹脆就把 GDI+ Bitmap 的圖像數據全部替換成原始數據。具體步驟是：
- 使用
GetDIBits函數，獲得通過GetImageMso得到的 StdPicture 的原始數據 - 使用
GdipBitmapLockBits函數取得 GDI+ 的 Bitmap 的圖像數據 - 把得到的 GDI+ Bitmap 的圖像數據替換成 StdPicture 的原始數據
- 使用
GdipBitmapUnlockBits函數把修改後的圖像數據寫回 Bitmap - 保存成 PNG 圖片
實踐之後，發現雖然 Alpha 值改變了，但導出的圖片仍然是白色背景。這是爲什麼呢？
發現原因
突然想到，GDI+ Bitmap 有多種像素格式，那麼使用 GdipCreateBitmapFromHBITMAP 函數得到的 Bitmap 的 PixelFormat 是什麼呢？
通過 GdipGetImagePixelFormat 函數得到 Bitmap 的 PixelFormat，發現是 PixelFormat32bppRGB。
這就不對了，透明背景的 Bitmap，PixelFormat 應該是 PixelFormat32bppARGB，上面的格式裏明顯少了一個 A，而正是這個 A 表示圖像是否能夠透明。
至此，就可以很容量理解上面一再試錯仍不成功的原因了。無論修改 Alpha 值也好，還是替換整個圖像數據也好，但 Bitmap 的 PixelFormat 仍然沒有變，依然是 PixelFormat32bppRGB，是不支持透明的。要想讓圖片透明，必須把 PixelFormat 變成支持透明的格式。
創建透明 Bitmap
發現了問題原因，解決辦法就很容易找到了。
既然 GdipCreateBitmapFromHBITMAP 函數得到的 Bitmap 是不透明的，那麼就沒必要在這上面折騰了，不如直接創建一個支持透明的圖片。具體思路是：
- 使用
GetDIBits函數，獲得通過GetImageMso得到的 StdPicture 的原始數據 - 使用
GdipCreateBitmapFromScan0函數創建一個PixelFormat32bppARGB格式的 Bitmap - 使用
GdipBitmapLockBits函數取得 Bitmap 的圖像數據區 - 複製 StdPicture 的原始數據到 Bitmap 的圖像數據區
- 使用
GdipBitmapUnlockBits函數把圖像數據寫回到 Bitmap - 把 Bitmap 保存成 PNG 圖片
Public Sub HBITMAPToBitmapARGB(gdiHdc As Long, gdiHBITMAP As Long, gdipBitmap As Long)
Dim bmi As BITMAPINFO
Dim bBits() As Byte
GetDIBitsInfo gdiHdc, gdiHBITMAP, bmi
GetDIBitsData gdiHdc, gdiHBITMAP, bmi, bBits
Dim bmWidth As Long, bmHeight As Long
bmWidth = bmi.bmiHeader.biWidth
bmHeight = Abs(bmi.bmiHeader.biHeight)
Dim rc As RECTL
rc.Left = 0
rc.Top = 0
rc.Right = bmWidth
rc.Bottom = bmHeight
Dim data() As Byte
ReDim data(rc.Right * 4 - 1, rc.Bottom - 1)
Dim BmpData As BitmapData
With BmpData
.Width = rc.Right
.Height = rc.Bottom
.PixelFormat = GpPixelFormat.PixelFormat32bppARGB
.scan0 = VarPtr(data(0, 0))
.stride = 4 * CLng(rc.Right)
End With
Dim lineSize As Long
lineSize = iIconBPP / 8 * bmWidth
Dim x As Long, y As Long, z As Long
Dim lineStart As Long, colorStart As Long
CreateBitmap gdipBitmap, bmWidth, bmHeight, PixelFormat32bppARGB
GdipBitmapLockBits gdipBitmap, rc, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, GpPixelFormat.PixelFormat32bppARGB, BmpData
For y = 0 To bmHeight - 1
lineStart = (bmHeight - y - 1) * lineSize
CopyMemory ByVal VarPtr(data(0, y)), ByVal VarPtr(bBits(lineStart)), lineSize
Next
GdipBitmapUnlockBits gdipBitmap, BmpData
End Sub
後記
在寫本文時，發現了兩個函數：
- GdipBitmapConvertFormat
- Bitmap.MakeTransparent
第一個函數 GdipBitmapConvertFormat 用於轉換像素格式，那麼我們把由 GdipCreateBitmapFromHBITMAP 函數得到的 Bitmap 的 PixelFormat 轉換成 PixelFormat32bppARGB，然後再修改 Alpha 值，是不是就可以生成透明背景的 PNG 了？
GdipBitmapConvertFormat 可以參考 https://bbs.csdn.net/topics/390320347
第二個函數 Bitmap.MakeTransparent 是 .NET 裏 Bitmap 類的 MakeTransparent 方法。這個方法可以把指定的顏色變爲透明色。那麼是不是可以考慮通過 Office PIA 的 CommandBarsClass.GetImageMso 得到圖標，再用 Image.FromHbitmap 轉換成 GDI+ Bitmap。此時得到的圖片應該是白色背景的，這時候再用 Bitmap.MakeTransparent 方法把白色變爲透明色，然後用 Bitmap.Save 方法保存成 PNG 格式圖片。
但是仔細想想，如果圖標中有白色的話，是不是也給變成透明色了，看來這個 Bitmap.MakeTransparent 還是不太適用。
源碼下載
https://download.csdn.net/download/blackwoodcliff/11180913
此源碼只適用於 32 位 Office，若要在 64 位 Office 上使用，需做如下修改：
- 將 Long 型變量替換成 LongLong 型
- 聲明 API 函數的語句中的 Declare 後面要加 PtrSafe