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 = 705End WithtabStrip1.Tabs(0).Caption = "1-500"tabStrip1.Tabs(1).Caption = "501-1000"Dim num As IntegerFor num = 1000 To 7000 Step 500tabStrip1.Tabs.Add "Forms.Tab." & (tabStrip1.Tabs.Count + 1), (num + 1) & "-" & (num + 500)Next numSet CheckBox1 = Me.Controls.Add("Forms.CheckBox.1", "checkBox1", True)With CheckBox1.Caption = "大图标".Left = 800.Top = 0.Width = 45.Height = 15.Value = TrueEnd WithDim CmdBtn As MSForms.CommandButtonDim rows As IntegerDim cols As IntegerFor rows = 1 To 20For cols = 1 To 25Set 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 = fmPicturePositionCenterEnd WithNext colsNext rows
End Sub

显示图标

获取 Office 图标的唯一方法 CommandBars.GetImageMso，用这个方法得到图标后，赋值给按钮的 Picture 属性。

Private Sub ShowImages()On Error Resume NextDim idx As Integer, imgIdx As IntegerDim btn As MSForms.CommandButtonDim pic As IPictureDispDim ImgSize As LongIf CheckBox1.Value = True Then ImgSize = 32 Else ImgSize = 16For idx = 1 To 500imgIdx = idx + 500 * tabStrip1.ValueSet btn = Me.Controls.Item("image" & idx)If imgIdx <= 7345 ThenSet pic = NothingSet 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 WithElsebtn.Visible = FalseEnd IfNext idx
End Sub

导出图标

要把图标导出到 PNG 文件，首先想到的就是使用 GDI+。GDI 不能处理 PNG 格式，可用 GDI+ 的 GdipCreateBitmapFromHBITMAP 函数把 StdPicture 转换成 GDI+ 的 Bitmap，然后再用 GdipSaveImageToFile 函数保存到 PNG 格式文件。
图样图森破，用这个方法虽然确实导出了 PNG 图片，但导出的 PNG 图片背景是白色的，这并不是我想要的结果，我希望导出的是背景透明的 PNG 图片。

试错

背景不透明，毫无疑问是 Alpha 值的问题。所以首先就想到，把转换来的 GDI+ 的 Bitmap 的 Alpha 值，根据原始图片的 Alpha 值重新设置一遍，然后再保存。具体思路是：

1. 使用 GetDIBits 函数，获得通过 GetImageMso 得到的 StdPicture 的原始数据
2. 使用 GdipBitmapGetPixel 函数取得 GDI+ 的 Bitmap 的每个像素值
3. 根据原始数据，修改每个像素的 Alpha 值
4. 使用 GdipBitmapSetPixel 函数，把修改 Alpha 后的像素值写回 Bitmap
5. 保存成 PNG 图片

经过实践，发现执行 GdipBitmapSetPixel 函数后，各个像素的 Alpha 值并没有改变，导出的图片仍然是白色背景。

再试错

接着上面的思路，既然单独修改 Alpha 值不好用，那么干脆就把 GDI+ Bitmap 的图像数据全部替换成原始数据。具体步骤是：

1. 使用 GetDIBits 函数，获得通过 GetImageMso 得到的 StdPicture 的原始数据
2. 使用 GdipBitmapLockBits 函数取得 GDI+ 的 Bitmap 的图像数据
3. 把得到的 GDI+ Bitmap 的图像数据替换成 StdPicture 的原始数据
4. 使用 GdipBitmapUnlockBits 函数把修改后的图像数据写回 Bitmap
5. 保存成 PNG 图片

实践之后，发现虽然 Alpha 值改变了，但导出的图片仍然是白色背景。这是为什么呢？

发现原因

突然想到，GDI+ Bitmap 有多种像素格式，那么使用 GdipCreateBitmapFromHBITMAP 函数得到的 Bitmap 的 PixelFormat 是什么呢？
通过 GdipGetImagePixelFormat 函数得到 Bitmap 的 PixelFormat，发现是 PixelFormat32bppRGB。
这就不对了，透明背景的 Bitmap，PixelFormat 应该是 PixelFormat32bppARGB，上面的格式里明显少了一个 A，而正是这个 A 表示图像是否能够透明。
至此，就可以很容量理解上面一再试错仍不成功的原因了。无论修改 Alpha 值也好，还是替换整个图像数据也好，但 Bitmap 的 PixelFormat 仍然没有变，依然是 PixelFormat32bppRGB，是不支持透明的。要想让图片透明，必须把 PixelFormat 变成支持透明的格式。

创建透明 Bitmap

发现了问题原因，解决办法就很容易找到了。
既然 GdipCreateBitmapFromHBITMAP 函数得到的 Bitmap 是不透明的，那么就没必要在这上面折腾了，不如直接创建一个支持透明的图片。具体思路是：

1. 使用 GetDIBits 函数，获得通过 GetImageMso 得到的 StdPicture 的原始数据
2. 使用 GdipCreateBitmapFromScan0 函数创建一个 PixelFormat32bppARGB 格式的 Bitmap
3. 使用 GdipBitmapLockBits 函数取得 Bitmap 的图像数据区
4. 复制 StdPicture 的原始数据到 Bitmap 的图像数据区
5. 使用 GdipBitmapUnlockBits 函数把图像数据写回到 Bitmap
6. 把 Bitmap 保存成 PNG 图片

Public Sub HBITMAPToBitmapARGB(gdiHdc As Long, gdiHBITMAP As Long, gdipBitmap As Long)Dim bmi As BITMAPINFODim bBits() As ByteGetDIBitsInfo gdiHdc, gdiHBITMAP, bmiGetDIBitsData gdiHdc, gdiHBITMAP, bmi, bBitsDim bmWidth As Long, bmHeight As LongbmWidth = bmi.bmiHeader.biWidthbmHeight = Abs(bmi.bmiHeader.biHeight)Dim rc As RECTLrc.Left = 0rc.Top = 0rc.Right = bmWidthrc.Bottom = bmHeightDim data() As ByteReDim data(rc.Right * 4 - 1, rc.Bottom - 1)Dim BmpData As BitmapDataWith BmpData.Width = rc.Right.Height = rc.Bottom.PixelFormat = GpPixelFormat.PixelFormat32bppARGB.scan0 = VarPtr(data(0, 0)).stride = 4 * CLng(rc.Right)End WithDim lineSize As LonglineSize = iIconBPP / 8 * bmWidthDim x As Long, y As Long, z As LongDim lineStart As Long, colorStart As LongCreateBitmap gdipBitmap, bmWidth, bmHeight, PixelFormat32bppARGBGdipBitmapLockBits gdipBitmap, rc, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, GpPixelFormat.PixelFormat32bppARGB, BmpDataFor y = 0 To bmHeight - 1lineStart = (bmHeight - y - 1) * lineSizeCopyMemory ByVal VarPtr(data(0, y)), ByVal VarPtr(bBits(lineStart)), lineSizeNextGdipBitmapUnlockBits 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

参考

• 提取Office 2003工具栏图标
• 【VB6 Gdi+进阶】序章
• 3. GDI+ Bitmap和GDI HBITMAP互转
• EXCEL VBA GetSaveAsFilename保存文件例子