论坛 › Excel 自习室 › VBA 获取系统自带所有命令FaceID 图标集

nothingwmm 发表于 2011-1-24 20:01

VBA 获取系统自带所有命令FaceID 图标集

本帖最后由 nothingwmm 于 2011-2-9 01:00 编辑

可以预览，欢迎回帖查看！
Option Explicit
Sub ShowFaceIDs()
    Dim NewToolbar As CommandBar
    Dim ctl As CommandBarButton
    Dim ID_Start As Integer, ID_End As Integer
    Dim TopPos As Long, LeftPos As Long
    Dim i As Long, Count As Long
    On Error Resume Next
    ID_Start = Range("FirstID").Value '获取ID的起始和终止值
    ID_End = Range("LastID").Value
    If Err.Number <> 0 Or (ID_Start > ID_End) Then
      MsgBox "Error - check the ID values", vbCritical
      Exit Sub
    End If
    On Error Resume Next
    Application.CommandBars("TempFaceIds").Delete '如果临时菜单存在，删除之
    On Error GoTo 0
    ActiveSheet.Pictures.Delete '清空所有图标
    Application.ScreenUpdating = False
    Set NewToolbar = Application.CommandBars.Add _
      (Name:="TempFaceIds", temporary:=True)
    NewToolbar.Visible = True '添加一个心的命令栏
    TopPos = 60 '设置图形放置的位置上端位置
    LeftPos = 16 '设置图形的左边位置
    Count = 1
    For i = ID_Start To ID_End
      On Error Resume Next
      NewToolbar.Controls(1).Delete '删除工具栏的第一个命令命令按钮
      On Error GoTo 0
      Set ctl = NewToolbar.Controls.Add(Type:=msoControlButton)
      ctl.FaceId = i
      ctl.CopyFace '添加新的按钮，复制图标
      ActiveSheet.Paste '粘贴到当前工作表中
      With ActiveSheet.Shapes(Count) '设置该图标的位置 名称 图片格式样式等
            .Top = TopPos
            .Left = LeftPos
            .Name = "FaceID " & i
            .PictureFormat.TransparentBackground = True '图片
            .PictureFormat.TransparencyColor = RGB(224, 223, 227) '图片的透明色
            .Fill.Visible = False
      End With
      LeftPos = LeftPos + 16 '添加完成后 位置向右移动
      If Count Mod 40 = 0 Then
            TopPos = TopPos + 16 '每行40个图标，然后向下移动一行16个单位
            LeftPos = 16
      End If
      Count = Count + 1
    Next i
    ActiveWindow.RangeSelection.Select
    Application.CommandBars("TempFaceIds").Delete '删除临时工具栏
End Sub**** Hidden Message *****

放浪形骸 发表于 2011-1-24 20:18

谢谢楼主的分享啊。。。

Yonlin 发表于 2011-2-17 04:32

ding~~~~~~~~

335081548 发表于 2011-2-24 12:14

隐藏了什么？？？

timeblue 发表于 2011-4-26 13:24

看看，非常实用

q6co 发表于 2011-7-26 23:16

{:031:}{:201:}{:131:}

roboby 发表于 2011-7-27 19:37

学习中……

tsigms 发表于 2011-8-29 08:08

多谢楼主！！

yjwdjfqb 发表于 2011-8-29 08:15

学习下。。。。。。

hxgfkfb 发表于 2012-4-25 16:09

aa                                 

查看完整版本: VBA 获取系统自带所有命令FaceID 图标集