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 值重新设置一遍，然后再保存。具体思路是：

使用 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 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保存文件例子

提取 Office 2016 工具栏图标相关推荐

VBA 提取 Office 2016 工具栏图标
Office 图标精美漂亮,作为微软的官方图标,与 Windows 具有一致的风格获取 Office 图标的唯一方法 CommandBars.GetImageMso Private Sub Show ...
office 2016 for mac 工具栏小三角下拉无法展开问题
office 2016 for mac 下拉框无法展开问题在mac 系统10.14.5下安装office2016后,office 2016 for mac ,word,excel,ppt 都出现工 ...
Mac Office 2016 版安装
首先可以在 Mac 上,自己去网上下载 Office 2016 版安装.在安装完成以后,请不要先登录自己的账户. 2如果在此之前已经在Office 中登录了微软账户的话,请先在 Mac 上删除Offi ...
在 Windows 操作系统中，PDFMaker 处理 Office 2016 和 Office 365 的文档时崩溃
上次更新日期: 2021年4月29日 | 同时适用于: Adobe Acrobat Adobe Acrobat PDFMaker(PDFMaker 工具栏/选项卡中的"转换为 Adobe P ...
Essential Studio for Windows Forms发布2017 v2，持office 2016和主题定制
2019独角兽企业重金招聘Python工程师标准>>> Essential Studio for Windows Forms是一个帮您创建高性能的Windows应用程序的Window ...
qtitanribbon注册_Qt组件QtitanRibbon教程：如何运用office 2016类
QtitanRibbon是一款遵循Microsoft Ribbon UI Paradigm for Qt技术的Ribbon UI组件,致力于为Windows.Linux和Mac OS X提供功能完整的 ...
Office 2016 到底有没有更新？
首先,我的 Office 2016 不是零售版,而是 VOL 的版本,所以你看不到 Update 选项零售版或者说 O365 的版本就会有 Update 选项默认版本号:16.0.4266.100 ...
深度：从 Office 365 新图标来看微软背后的设计新理念
开始表演请关注我的公众号"寒树Office"来获取一些新鲜而有趣的新闻与知识,最近又有两家俱乐部上线了(东莞与长沙),俱乐部的活动告一段落,接下来的日子里我将持续与大家分享 Of ...
全新的Microsoft Office 2016发布，以更少步骤更快地执行工作
微软在旧版Office基础上对软件做了升级,打造了全新的 Office 2016 办公软件,Office 2016新功能包括附带的Office移动应用程序,其中包括家庭版.个人版及专业版等多个Offi ...

提取 Office 2016 工具栏图标