Office 图标精美漂亮,作为微软的官方图标,与 Windows 具有一致的风格
获取 Office 图标的唯一方法 CommandBars.GetImageMso
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
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
原文:提取 Office 2016 工具栏图标_blackwood-cliff的博客-CSDN博客_office 工具栏图标