Pergunta

Eu gostaria de criar um botão de menu personalizado usando VBA no meu arquivo excel 2010 usando um botão Excel predefinido que usa id de rosto.No meu caso, gostaria de usar os ícones de "bloquear" e "atualizar", mas não conheço a identificação de rosto desse ícone.Alguém poderia me mostrar ou apontar a lista de identificação de botão e rosto usada no Excel 2010?

Foi útil?

Solução

Dê uma olhada aqui:

IDs de rosto

É um addin para o MS Excel.Funciona no Excel 97 e posterior.

Outras dicas

O seguinte Sub BarOpen () funciona com o Excel 2010, provavelmente também com muitas outras versões também, e gera na guia "Add-Ins" uma barra de ferramentas temporária personalizada com menus suspensos para mostraros FaceIDs de 1 .. 5020 em grupos de 30 itens.

Option Explicit

Const APP_NAME = "FaceIDs (Browser)"

' The number of icons to be displayed in a set.
Const ICON_SET = 30

Sub BarOpen()
  Dim xBar As CommandBar
  Dim xBarPop As CommandBarPopup
  Dim bCreatedNew As Boolean
  Dim n As Integer, m As Integer
  Dim k As Integer

  On Error Resume Next
  ' Try to get a reference to the 'FaceID Browser' toolbar if it exists and delete it:
  Set xBar = CommandBars(APP_NAME)
  On Error GoTo 0
  If Not xBar Is Nothing Then
    xBar.Delete
    Set xBar = Nothing
  End If

  Set xBar = CommandBars.Add(Name:=APP_NAME, Temporary:=True) ', Position:=msoBarLeft
  With xBar
    .Visible = True
    '.Width = 80
    For k = 0 To 4 ' 5 dropdowns, each for about 1000 FaceIDs
      Set xBarPop = .Controls.Add(Type:=msoControlPopup) ', Before:=1
      With xBarPop
        .BeginGroup = True
        If k = 0 Then
          .Caption = "Face IDs " & 1 + 1000 * k & " ... "
        Else
          .Caption = 1 + 1000 * k & " ... "
        End If
        n = 1
        Do
          With .Controls.Add(Type:=msoControlPopup) '34 items * 30 items = 1020 faceIDs
            .Caption = 1000 * k + n & " ... " & 1000 * k + n + ICON_SET - 1
            For m = 0 To ICON_SET - 1
              With .Controls.Add(Type:=msoControlButton) '
                .Caption = "ID=" & 1000 * k + n + m
                .FaceId = 1000 * k + n + m
              End With
            Next m
          End With
          n = n + ICON_SET
        Loop While n < 1000 ' or 1020, some overlapp
      End With
    Next k
  End With 'xBar
End Sub

Modificada a resposta anterior para criar várias barras de ferramentas com conjuntos de 10 ícones.Pode alterar o código (comentar / descomentar), o número de barras de ferramentas (o desempenho pode ser lento em máquinas mais lentas)

O último número de ícone do Office 2013 que consegui encontrar foi 25424 do OneDrive

Sub FaceIdsOutput()
' ==================================================
' FaceIdsOutput Macro
' ==================================================
' =========================
Dim sym_bar As CommandBar
Dim cmd_bar As CommandBar
' =========================
Dim i_bar As Integer
Dim n_bar_ammt As Integer
Dim i_bar_start As Integer
Dim i_bar_final As Integer
' =========================
Dim icon_ctrl As CommandBarControl
' =========================
Dim i_icon As Integer
Dim n_icon_step As Integer
Dim i_icon_start As Integer
Dim i_icon_final As Integer
' =========================
n_icon_step = 10
' =========================
i_bar_start = 1
n_bar_ammt =  500
' i_bar_start = 501
' n_bar_ammt =  1000
' i_bar_start = 1001
' n_bar_ammt =  1500
' i_bar_start = 1501
' n_bar_ammt =  2000
' i_bar_start = 2001
' n_bar_ammt =  2543
i_bar_final = i_bar_start + n_bar_ammt - 1
' =========================
' delete toolbars
' =========================
For Each cmd_bar In Application.CommandBars
    If InStr(cmd_bar.Name,"Symbol") <> 0 Then
        cmd_bar.Delete
    End If
Next
' =========================
' create toolbars
' =========================
For i_bar = i_bar_start To i_bar_final
    On Error Resume Next
    Set sym_bar = Application.CommandBars.Add _
        ("Symbol" & i_bar, msoBarFloating, Temporary:=True)
    ' =========================
    ' create buttons
    ' =========================
    i_icon_start = (i_bar-1) * n_icon_step + 1
    i_icon_final = i_icon_start + n_icon_step - 1
    For i_icon = i_icon_start To i_icon_final
        Set icon_ctrl = sym_bar.Controls.Add(msoControlButton)
        icon_ctrl.FaceId = i_icon
        icon_ctrl.TooltipText = i_icon
        Debug.Print ("Symbol = " & i_icon)
    Next i_icon
    sym_bar.Visible = True
Next i_bar
End Sub
Sub DeleteFaceIdsToolbar()
' ==================================================
' DeleteFaceIdsToolbar Macro
' ==================================================
Dim cmd_bar As CommandBar
For Each cmd_bar In Application.CommandBars
    If InStr(cmd_bar.Name,"Symbol") <> 0 Then
        cmd_bar.Delete
    End If
Next
End Sub

Encontrei neste local o que estou olhando

http://support.microsoft.com/default.aspx?scid=kb;[LN];Q213552

A tabela contém o controle e id (Face Id) usados no excel.Portanto, para o botão "Atualizar", a identificação do rosto é 459, mas só funciona na identificação com menos de 3 dígitos.

e este gerador (inserindo ID de face inicial e ID de face final), clique em mostrar faces de botão, você obterá a lista de ícones no intervalo (para fazer o download, primeiro faça o login)

http://www.ozgrid.com/forum/showthread.php?t= 39992

e isso para a barra de ferramentas da faixa de opções

http://www.rondebruin.nl/ribbon.htm

script curto escreve dez (loop definido para 10) adições de FaceID.como entrada na guia "Add-In" da barra de ferramentas e com "Benutzerdefinierte Symbolliste löschen" - você apaga esta entrada adicionada (marque e clique com o botão direito do mouse) - funciona com o excel 2010/2013

Sub FaceIdsAusgeben()
Dim symb As CommandBar
Dim Icon As CommandBarControl
Dim i As Integer
On Error Resume Next
Set symb = Application.CommandBars.Add _
("Symbole", msoBarFloating)
For i = 1 To 10
Set Icon = symb.Controls.Add(msoControlButton)
Icon.FaceId = i
Icon.TooltipText = i
Debug.Print ("Symbole = " & i)
Next i
symb.Visible = True
End Sub

o script fornece na planilha o nome dos controles do excel 2010/2013

Sub IDsErmitteln()
Dim crtl As CommandBarControl
Dim i As Integer
Worksheets.Add
On Error Resume Next
i = 1
For Each crtl In Application.CommandBars(1).Controls(1).Controls
Cells(i, 1).Value = crtl.Caption
Cells(i, 2).Value = crtl.ID
i = i + 1
Next crtl
End Sub
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top