Conheça o Júlio Battisti

Julio Battisti - Autor de mais de 25 livros de informática Júlio Battisti tem mais de 50 livros publicados, centenas de e-books e é certificado Microsoft.

SAIBA MAIS...

Loja Virtual do Site

Curta Nossa Fanpage

« Anterior

Δ Página principal

¤ Índice

Próxima »

Programando o RibbonX no Excel 2007
Autor: Robert Friedrick Martim

Lição 19 - Automatizando o processo de criação: utilizando VBA para gerar o XML

Passada a primeira parte, queremos agora levar a nossa customização ao próximo nível. Acho que deve estar bastante claro para o leitor que construir uma personalização da Faixa de Opções não é tarefa simples, msmo para os que utilizam esquemas XML no VS.NET ou Visual Web Developer Express Edition.

Aqui desenvolvo uma breve idéia de como podemos criar o código XML utilizando VBA. O apêndice C foi criado utilizando este mesmo esquema.

Vejamos a seguinte personalização da Faixa de Opções:

Figura 13‑1 Faixa Personalizada

Temos aqui dois grupos com seis botões sendo que um deles é um splitbutton. Vejamos agora o XML por trás disso tudo:

<customUI  xmlns="http://schemas.microsoft.com/office/2006/01/customui">
     <ribbon startFromScratch="true">
       <tabs>
        <tab 
           id="idTab1" 
           label="Minha Guia" 
            keytip= "CV" 
            insertBeforeMso="TabHome" 
        >
         <group 
           id="idGrp1" 
           label="Meu Grupo 1" 
          >
          <button 
            id="idBtn1" 
            label="Meu botao 1" 
            imageMso="ActiveXImage" 
            onAction="onAction" 
           screentip= "Esta é uma screentip" 
           supertip="Esta é uma supertip" 
            size="large" 
         />
         <button 
           id="idBtn2" 
           label="Meu botao 2" 
            imageMso="ActiveXListBox" 
            onAction="onAction" 
           screentip= "Esta é uma screentip" 
           supertip="Esta é uma supertip" 
            size="large" 
         />
         <button 
           id="idBtn3" 
           label="Meu botao 3" 
            imageMso="AutoFormatDialog" 
            onAction="onAction" 
           screentip= "Esta é uma screentip" 
           supertip="Esta é uma supertip" 
            size="large" 
         />
         </group>
         <group 
           id="idGrp2" 
           label="Meu Grupo 2" 
         >
         <splitButton  
           id="idSplitBtn1" 
           size="large" 
         >
         <button 
           id="idBtn4" 
           label="Meu botao 4" 
           imageMso="Camera" 
            onAction="onAction" 
            screentip= "Esta é uma screentip" 
            supertip="Esta é uma supertip" 
          />
         <menu  
           id="idSplitMnu1" 
         >
         <button 
           id="idBtn5" 
           label="Meu botao 5" 
           imageMso="CloseAll" 
           onAction="onAction" 
           screentip= "Esta é uma screentip" 
            supertip="Esta é uma supertip" 
          />
         <button 
           id="idBtn6" 
           label="Meu botao 6" 
           imageMso="ConditionalFormatting" 
           onAction="onAction" 
           screentip= "Esta é uma screentip" 
           supertip="Esta é uma supertip" 
          />
         </menu>
         </splitButton>
         </group>
        </tab>
       </tabs>
     </ribbon>
   </customUI>

Uma leve pesonalização e temos uma montanha de código XML (veja o montante de código XML contido no Apêndice C).

Obviamente que escrever isso tudo consome um tempo enorme. E se precisarmos rearranjar os objetos? Tudo isso consumirá mais tempo ainda.

O leitor pode desenvolver algum método para facilitar o trabalho. Neste caso específico, utilizo uma planilha para armazenar os detalhes (que podem ser rearranjados) e VBA:

Figura 13‑2 Tabela contendo os detalhes dos objetos da Faixa de Opções

A vantagem aqui é que podemos armazenar o esquema e refazer o XML quantas vezes desejarmos.

Originalmente, havia feito tal código no grupo privado de MVP, portanto, o manterei em inglês:

                  Dim getClipboard    As DataObject

Sub makeXML()
       Dim lngRow              As Long
       Dim id                  As String
       Dim idMso               As String
       Dim img                 As String
       Dim XMLAction           As String
       Dim Label               As String
       Dim Action              As String
       Dim screenTip           As String
       Dim keyTip              As String
       Dim superTip            As String
       Dim itemSize            As String
       Dim size                As String
       Dim imgMso              As String
       Dim insertBeforeMso     As String
       
       
       Dim ws          As Worksheet
       Dim appWord     As Object
       Dim wrdDoc      As Object
       
       On Error GoTo Err_Handler
       Set appWord =  CreateObject("Word.Application")
       Set wrdDoc = appWord.Documents.Add
       Set getClipboard = New DataObject
       
       With wrdDoc.ActiveWindow.Selection
       appWord.Visible = True
           .WholeStory
           .ClearFormatting
           .Font.Name = "Courier New"
           .Font.size = 10
           .TypeText Text:="<customUI  xmlns=" & Chr(34) & _
                "http://schemas.microsoft.com/office/2006/01/customui" &  Chr(34) & ">"
       
           Set ws =  ThisWorkbook.Sheets("Data")
       
           lngRow = 2
       
           Do Until IsEmpty(ws.Cells(lngRow, 1))
               XMLAction = ws.Cells(lngRow, 1)
               
               id = hasID(ws.Cells(lngRow, 3))
               idMso = hasIdMso(ws.Cells(lngRow,  4))
               Label = hasLabel(ws.Cells(lngRow,  5))
               insertBeforeMso =  hasinsertBeforeMso(ws.Cells(lngRow, 6))
               keyTip = hasKeyTip(ws.Cells(lngRow,  7))
               size = hasSize(ws.Cells(lngRow, 8))
               itemSize =  hasItemSize(ws.Cells(lngRow, 8))
               img = hasImg(ws.Cells(lngRow, 9))
               imgMso = hasImgMso(ws.Cells(lngRow,  10))
               Action = hasAction(ws.Cells(lngRow,  11))
               screenTip =  hasScreenTip(ws.Cells(lngRow, 12))
               superTip =  hasSuperTip(ws.Cells(lngRow, 13))
               
                   '*****************************************************************************************
                   'OPENS AND CLOSES DE TAGS  FOR THE RIBBON

            Select Case UCase(XMLAction)
                   Case "OPENRIBBON"
                       .TypeParagraph
                       .TypeText Text:="  <ribbon startFromScratch=" &  Chr(34) & _
                           LCase(ws.Cells(lngRow, 2))  & Chr(34) & ">"
                   
                   Case "CLOSERIBBON"
                       .TypeParagraph
                       .TypeText Text:="  </ribbon>"

'*****************************************************************************************
                   'OPENS AND CLOSES DE TAGS  FOR THE TABS
                   Case "OPENTABS"
                       .TypeParagraph
                       .TypeText Text:="    <tabs>"
                   
                   Case "CLOSETABS"
                       .TypeParagraph
                       .TypeText Text:="    </tabs>"
                       
                   '*****************************************************************************************
                   'OPENS AND CLOSES DE TAGS  FOR THE TAB
                   Case "OPENTAB"
                       .TypeParagraph
                       .TypeText Text:="     <tab " & vbCr & _
                                               id  & _
                                                idMso & _
                                                Label & _
                                               keyTip  & _
                                                insertBeforeMso & _
                                                "     >"
                   
                   Case "CLOSETAB"
                       .TypeParagraph
                       .TypeText Text:="     </tab>"
                   
                   '*****************************************************************************************
                   'OPENS AND CLOSES DE TAGS  FOR THE GROUP
                   Case "OPENGROUP"
                       .TypeParagraph
                       .TypeText Text:="      <group " & vbCr & _
                                               id  & _
                                                idMso & _
                                                Label & _
                                               "      >"
                           
                   Case "CLOSEGROUP"
                       .TypeParagraph
                       .TypeText Text:="      </group>"

'*****************************************************************************************
                   'OPENS AND CLOSES DE TAGS  FOR THE BUTTON
                   Case "OPENBUTTON"
                       .TypeParagraph
                       .TypeText Text:="      <button " & vbCr & _
                                               id  & _
                                               idMso & _
                                                Label & _
                                                imgMso & _
                                               img  & _
                                                Action & _
                                               screenTip &  _
                                                superTip & _
                                                size & _
                                                "      />"

'*****************************************************************************************
                   'OPENS AND CLOSES DE TAGS  FOR THE SPLITBUTTON
                   Case  "OPENSPLITBUTTON"
                       .TypeParagraph
                       .TypeText Text:="      <splitButton  " & vbCr & _
                                               id & _
                                                idMso & _
                                                size & _
                                                "      >"
                           
                   Case "CLOSESPLITBUTTON"
                       .TypeParagraph
                       .TypeText Text:="      </splitButton>"

'*****************************************************************************************
                   'OPENS AND CLOSES DE TAGS  FOR THE SPLITBUTTONMENU
                   Case  "OPENSPLITBUTTONMENU"
                       .TypeParagraph
                       .TypeText Text:="      <menu   " & vbCr & _
                                               id  & _
                                                idMso & _
                                               itemSize & _
                                                "      >"

                Case  "CLOSESPLITBUTTONMENU"
                       .TypeParagraph
                       .TypeText Text:="      </menu>"

            End Select
               
               lngRow = lngRow + 1
           Loop
           
           .TypeParagraph
           .TypeText  Text:="</customUI>"
           .WholeStory
           .Copy
           getClipboard.GetFromClipboard
       End With

    
                   Cleanup:
                   '    wrdDoc.Saved = True
                   '    wrdDoc.Close
                   '    appWord.Quit
       
       Set wrdDoc = Nothing
       Set appWord = Nothing
       
       MsgBox "Code is ready to be pasted  onto XML editor.", vbInformation
       Exit Sub
                   Err_Handler:
       MsgBox Err.Description, vbCritical,  Err.Number
       Resume Cleanup
                   End Sub

Function hasID(ByVal value  As String) As String
       If value = "" Then
           hasID = ""
       Else
           hasID = "        id=" & Chr(34) & value  & Chr(34) & vbCr
       End If
                   End Function

Function hasIdMso(ByVal  value As String) As String
       If value = "" Then
           hasIdMso = ""
       Else
           hasIdMso = "        idMso=" & Chr(34) & value  & Chr(34) & vbCr
       End If
                   End Function

Function hasLabel(ByVal  value As String) As String
       If value = "" Then
           hasLabel = ""
       Else
           hasLabel = "        label=" & Chr(34) & value  & Chr(34) & vbCr
       End If
                   End Function

Function hasAction(ByVal  value As String) As String
       If value = "" Then
           hasAction = ""
       Else
           hasAction = "        onAction=" & Chr(34) &  value & Chr(34) & vbCr
       End If
                   End Function

Function hasScreenTip(ByVal  value As String) As String
       If value = "" Then
           hasScreenTip = ""
       Else
           hasScreenTip = "        screentip= " & Chr(34) &  value & Chr(34) & vbCr
       End If
                   End Function

Function hasKeyTip(ByVal  value As String) As String
       If value = "" Then
           hasKeyTip = ""
       Else
           hasKeyTip = "        keytip= " & Chr(34) &  value & Chr(34) & vbCr
       End If
                   End Function

Function hasSuperTip(ByVal  value As String) As String
       If value = "" Then
           hasSuperTip = ""
       Else
           hasSuperTip = "        supertip=" & Chr(34) &  value & Chr(34) & vbCr
       End If
                   End Function

Function hasSize(ByVal value  As String) As String
       If value = "" Then
           hasSize = ""
       Else
           hasSize = "        size=" & Chr(34) & value  & Chr(34) & vbCr
       End If
                   End Function

Function hasItemSize(ByVal  value As String) As String
       If value = "" Then
           hasItemSize = ""
       Else
           hasItemSize = "        itemSize=" & Chr(34) &  value & Chr(34) & vbCr
       End If
                   End Function

Function hasImgMso(ByVal  value As String) As String
       If value = "" Then
           hasImgMso = ""
       Else
           hasImgMso = "        imageMso=" & Chr(34) &  value & Chr(34) & vbCr
       End If
                   End Function

Function hasImg(ByVal value  As String) As String
       If value = "" Then
           hasImg = ""
       Else
           hasImg = "        image=" & Chr(34) & value  & Chr(34) & vbCr
       End If
                   End Function

Function  hasinsertBeforeMso(ByVal value As String) As String
       If value = "" Then
           hasinsertBeforeMso = ""
       Else
           hasinsertBeforeMso = "        insertBeforeMso=" & Chr(34)  & value & Chr(34) & vbCr
       End If
                   End  Function

Embora já tenhamos visto os tags XML para utilização na Faixa de Opções, coloco aqui uma lista para fácil referência:

Tag de abertura	Tag de fechamento	Função
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">	</customUI>	Nível de topo. Utilize para abrir a seqüência de customização da Faixa de Opções
<Ribbon>	</Ribbon>	Tag referente à Faixa de Opções
<Tabs>	</Tabs>	Tag refere às guias, isto é à coleção de guias da Faixa de Opções
<Tab>	</Tab>	Refere-se à uma guia em específico. Utilize para adicionar ou manipular uma guia existente
<Group>	</Group>	Refere-se à um grupo em específico. Utilize para adicionar ou manipular um grupo existente
<Button>	</Button>	Refere-se à um botão comum em específico. Utilize para adicionar ou manipular um botão existente
<toggleButton>	</toggleButton>	Refere-se à um botão de alternância em específico. Utilize para adicionar ou manipular um botão de alternância existente
<checkBox>	</ checkBox>	Refere-se à uma caixa de checagem em específico. Utilize para adicionar ou manipular uma caixa de checagem existente
<splitButton>	</ splitButton>	Refere-se à um botão “split” em específico. Utilize para adicionar ou manipular um botão “split” existente
<officeMenu>	</officeMenu>	Refere-se ao menu “Arquivo” (File) o qual é acessado através do logo do Office. Na versão Beta 2 era denominado fileMenu.
<Menu>	</ Menu>	Refere-se a um menu qualquer, como os menus existentes sob o officeMenu
<gallery>	</ gallery>	Refere-se a uma galeria que pode incluir fotos, ícones, etc.
<dialogBoxLauncher>	</dialogBoxLauncher>	Refere-se ao Iniciador de Caixas de Diálogo. Na versão Beta 2 era denominado advanced.
<dropDown>	</dropDown>	Refere-se ao objeto estilo caixa de combinação. Note a diferença este este controle e uma combobox
<labelControl>	</labelControl>	Refere-se ao objeto “rótulo”. Este objeto pode ser utilizado para substituir o rótulo de outros objetos, por exemplo.
<dynamicMenu>	</dynamicMenu>	Refere-se ao menu dinâmico.
<comboBox>	</comboBox>	Refere-se à uma caixa de combinação. Constrate com o objeto dropDown.
<item>	</item>	Refere-se a um item de uma lista como dropDown, combobox, galerry, etc.
<commands>	</commands>	Refere-se à coleção de comandos.
<command>	</command>	Refere-se à um comando qualquer dentro da coleção de comandos (commands).

« Anterior

Δ Página principal

¤ Índice

Próxima »

Quer Aprender VBA no Excel, Sem Dificuldades, com Exemplos
Práticos Passo a Passo e com Explicações Detalhadas?

Aprenda com Júlio Battisti: "Macros e Programação VBA no Excel 2010 Através de Exemplos Práticos e Úteis - Passo a Passos

Junto com o livro você Recebe 11 Bônus Incluindo 50 horas de Vídeo Aulas.

Mesmo que Você não Saiba Nada de Programação VBA ou já Tenha Tentado
Aprender VBA e Desistiu ou Achou Difícil, com Este Livro EU GARANTO que Você Aprenderá, SEM DIFICULDADES. APRENDIZADO GARANTIDO.

Clique Aqui Para Todos os Detalhes sobre Esta Oferta

- É com alegria que Comunico o lançamento do meu 42º Livro.

- Perfeito para Iniciantes em Programação VBA.

- Abordo desde o Básico até Comandos Avançados.

- Códigos detalhadamente explicados, linha por linha.

- Criação de Funções e Procedimentos com VBA.

- O Modelo de Objetos do Excel - Exemplos Práticos.

- Criação de Formulários - UseForms.

- Criação de um Sistema de Cadastro Completo, com Foto.

- Como trabalhar com Tabelas Dinâmicas na Programação VBA.

- Como trabalhar com Gráficos na Programação VBA.

- Rotina que Escreve um número por Extenso usando VBA.

- E muito, muito mais mesmo...

- Junto com o livro você recebe 50 horas de Vídeo Aulas sobre Macros, Programação VBA, Fórmulas e Funções Avançadas, Dashboards e Muito mais.

[Bônus]: 60 horas de Vídeo Aulas sobre Macros, Programação VBA, Fórmulas e Funções Avançadas no Excel, Recursos Avançados, Dashboards e Muito mais.

A BÍBLIA DA
PROGRAMAÇÃO
VBA NO EXCEL

Júlio Battisti Livros e Cursosa sua sala de aula na internet