Suplementos em Excel - XLA

DEFINIÇÃO DA MICROSOFT

Os suplementos são programas que adicionam comandos e recursos opcionais ao Microsoft Excel.
Antes de usar um suplemento, você precisa instalá-lo no computador e, em seguida, carregá-lo
no Microsoft Excel. Por padrão, os suplementos (arquivos *.xla) são instalados na pasta Biblioteca
da pasta do Microsoft Excel. O carregamento de um suplemento disponibiliza o recurso no
Microsoft Excel e adiciona todos os comandos associados aos menus adequados. Os programas
suplementares listados na tabela a seguir são instalados, por padrão, na pasta Biblioteca, ou em
uma de suas subpastas, na pasta do Microsoft Excel. Se você não conseguir localizar determinado
suplemento no disco rígido ou em uma unidade da rede, poderá instalá-lo. Após instalar um
suplemento, será necessário usar o comando Suplementos (menu Ferramentas) para carregá-lo no
Microsoft Excel.


A partir dessa breve explicação vamos desenvolver nossa aplicação uma Agenda simples, porem muito funcional.

As Ferramentas necessárias

Para a criação de nossa Agenda de Tarefas precisaremos de um formulário para a inclusão e
consulta das tarefas agendadas , de uma planilha que servirá para armazenar as informações e ou-
tra planilha que servirá como relatório caso se deseje imprimir as anotações do dia.

O Formulário

Crie o formulário Agenda utilizando as especificações que fazem parte da Tabela a seguir:

Objeto Propriedade Ajuste
Formulário Name frmAgenda
Caption Anote Seus Afazeres e Lembretes para o ano de 2011

TextBox1 Name BoxDia
Font Takoma 10
TextAlign 2 - Center

TextBox2 Name BoxAnotações
Font Takoma 8
TextAlign 1 - Left
EnterKeyBehavior True
MultiLine True

TextBox3 Name BoxResumo
Font Takoma 8
TextAlign 1 - Left
EnterKeyBehavior True
MultiLine True
ScroollBars 3 - FmScrollBarsBoth


CommandButton1 Name CmdSair
Caption Incluir/Alterar

CommandButton2 Name CmdImpressão
Caption Imprimir

Label1 Name Label1
Caption Dia/Mês

Label2 Name Label2
Caption Hora

Label3 Name Label3
Caption Hora

Label4 Name Label4
Caption Anotações

Label5 Name Label5
Caption Anotação


A Tabela

Crie um planilha que servirá de tabela para armazenar os dados diários de sua agenda.
Está tabela terá 367 linhas que serão os dias do ano e 25 colunas que serão as horas do dia em que serão anotados os afazeres. Como os campos da tabela são fixos 367 linhas por 24 colunas, utilizaremos as funções internas do Excel para trabalhar os dados com a mesma eficiência.

A Agenda

Crie uma planilha para que você possa ter suas informações diárias em mãos através de um formulário, onde você poderá imprimi-la e levar com você para obde você quiser. Nem sempre as informações somente virtuais são necessárias, tem ocasiões que necessitamos de um relatório para trabalharmos.

O Programa Agenda

Como funcionará o Programa Agenda:

Com o formulário ativado você deverá digitar um dia do ano de 2011 no BoxDia e automaticamente o sistema responderá fazendo uma varreadura na tabela "datas" para encontrar o dia digitado e preencherá o ComboHora com a 1ª Hora do dia, no caso 1:00, e o BoxResumo com as anotações horárias. Para digitar a tarefa ou afazer de uma determinada hora basta preencher o BoxAnotação e clicar no botão Incluir/Alterar.

Codificação do Programa Agenda

Inclua o seguinte código no procedimento UserForm_Activate( ) do formulário:

Private Sub UserForm_Activate()
Dim Cont
Me.ComboHora.Clear
For Cont = 1 To 24
Me.ComboHora.AddItem Format(Cont & ":00", "h:mm")
Next
Me.BoxDia = Format(Date, "dd/mm")
End Sub

Como uma agenda diária serve para anotações de seus afazeres em determinadas horas,
precisamos então de um objeto em que possamos selecionar determinada hora. Esse objeto em nosso aplicativo é o ComboHora.

Para se preencher um ComboBox existem duas maneiras:
1º Utilizando a propriedade RowSource do ComboBox, mencionado o intervalo de células que se deseja preencher o combo;

2º Preenchendo o ComboBox em tempo de execução, ou seja, preencher o ComboBox toda vez que o Userform for carregado.
Para se preencher um ComboBox em tempo de execução devemos utilizar a propriedade AddItem
Ex.: ComboExemplo.AddItem "Laranja"
ComboExemplo.AddItem "Banana"

No exemplo acima teremos um ComboBox com uma lista preenchida com os itens Laranja e Banana.

No nosso programa precisaremos preencher uma Combo com o intervalo de horas 1:00 e 24:00.Poderíamos preencher essa lista um a um como no exemplo anterior, mas é nesta hora que a lógica de programação toma conta. utilizaremos a instrução For... Next... , que significa percorrer um certo intervalo, e em cima deste intervalo poderemos ir preenchendo o ComboBox.

Private Sub boxdia_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.BoxDia = "" Then
Else
If IsDate(Me.BoxDia) Then
Me.ComboHora.ListIndex = -1
Me.BoxDia = Format(Me.BoxDia, "dd/mm")
Me.ComboHora.ListIndex = 0
Else
MsgBox "Data inválida...", vbCritical, "Minhas tarefas e lembretes.."
Cancel = True
End If
End If
End Sub

Detalhamento do código no procedimento boxdia_Exit( ) do formulário:

Como o BoxDia é a principal interface do aplicativo, é importantíssimo que mesmo seja preenchido corretamente para o perfeito funcionamento do aplicativo. Para que isso ocorra utilizamos uma função interna no Excel chamada IsDate. A função IsDate tem como objetivo checar se no objeto TextBox foi digitada uma data válida. Se sim o BoxDia é validado, senão o cursor permanecerá no TextBox até a correta digitação. Isto é feito graças ao ByVal da evento Exit. onde Cancel = true permi-
te que só se siga adiante se a informação for correta.
Outra Função utilizada é a Format, que permite deixar o TextBox do jeito que se quer. No código acima no BoxDia deve ser digitado uma data. Quando esta data for validada o a função Format transforma esta data em dia e mês já que o ano não é necessário ano pois a agenda é do ano de 2011.
No caso do BoxDia se for digitado 01/01/2011 a função Format retornará o BoxDia em 01/01.


Inclua o seguinte código no procedimento ComboHora_Click( ) do formulário:

Dê dois cliques sobre o ComboHora e o evento ComboHora_Click( ) é ativado. Dentro do evento digite o seguinte código:


Private Sub combohora_Click()
Me.PesquisarData
End Sub

Detalhamento do código no procedimento ComboHora_Click( ) do formulário:

Dentro do evento digitamos a palavra reservada "Me", que tem como função substituir o nome do formulário. Se digitarmos "FrmAgenda.PesquisarData" também está correto, e PesquisarData simplesmente também, porém o ideal é que se digite o endereço onde o código está alocado para que o sistema saiba qual código você está se referindo, pois pode ocorrer de ter dois códigos com o mesmo nome em módulos de programas diferentes, o que é permitido.
Já o termo "PesquisarData" é um código de programação que você verá abaixo. Com isso você acaba de aprender que podemos chamar um código de programação dentro de outro código, basta referenciar corretamente. Qual é a vantagem de se chamar um código dentro de outro código ?
Simples, para que um código não se torne muito longo.

Inclua o seguinte código no procedimento PesquisarData( ) dentro do módulo do formulário:


Sub PesquisarData()
Dim Célula As Excel.Range
Dim StrData, i, nLinha, Cont
i = 1
Me.BoxAnotação = ""
Me.BoxResumo = ""
For Each Célula In ThisWorkbook.Sheets("datas").Range("nDatas").Cells
StrData = Célula.Value
i = i + 1
If CDate(Me.BoxDia) = CDate(StrData) Then
nLinha = i
Me.BoxAnotação = Plan2.Cells(i, Me.ComboHora.ListIndex + 2)
For Cont = 1 To 24
Me.BoxResumo = Me.BoxResumo & Chr(10) & Plan2.Cells(1, Cont + 1) & _
":00 - " & Plan2.Cells(i, Cont + 1)
Next
Exit For
End If
Next
End Sub

Detalhamento do código PesquisarData:

Com a planilha "datas" criada devemos primeiramente saber que quando folheamos uma agenda a principal parâmetro é a data. A Data é a base de toda consulta em nossa agenda. Aqui no nosso programa também, as datas são o centro de todas as atenções, e em cima disto vamos selecionar todas as células que fazem parte das datas de nossa agenda, no nosso caso é o intervalo compreendido "A2:A367" e clicando sobre a caixa de nomes vamos renomear este intervalo para "nDatas".

Como o Código PesquisarData funciona:

O sistema irá percorrer todo intervalo nDatas que você nomeou e localizando a data que você digitar no BoxDia irá automaticamente preencher o BoxAnotação com a anotação da 1ª hora, e irá preencher o BoxResumo com todas anotações do dia em ordem de hora.
Utilizamos a instrução For Each in para percorrer todo intervalo nDatas para descobrir qual célula tem a data igual ao BoxDia.

Inclua o seguinte código no procedimento CmdIncluir_Click( ) do formulário:


Private Sub CmdIncluir_Click()
Me.Incluir_Alterar
Me.PesquisarData
End Sub

Detalhamento do código no procedimento ComboHora_Click( ) do formulário:

Como no ComboHora dentro o procedimento CndIncluir_Click( ) foi digitado o nome de outro procedimento, o Incluir_alterar. A Função deste botão é de Incluir uma nova anotação ou alterar alguma anotação existente.

Criação do procedimento incluir_Alterar:

Sub Incluir_Alterar()
Dim Célula As Excel.Range
Dim StrData, i, nLinha
i = 1
For Each Célula In ThisWorkbook.Sheets("datas").Range("nDatas").Cells
StrData = Célula.Value
i = i + 1
If CDate(Me.BoxDia) = CDate(StrData) Then
nLinha = i
Plan2.Cells(i, Me.ComboHora.ListIndex + 2) = Me.BoxAnotação
Exit For
End If
Next
End Sub

Neste procedimento utilizamos praticamente a mesma rotina do procedimento PesquisarData, pois já que a tabela é fixa (366 linhas x 24 colunas ) a única função deste procedimento é localizar um dia e alterar a anotação existente ou incluir uma anotação caso a célula esteja vazia.

Basicamente fica fácil demonstrar que com poucas linhas de comando e poucos objetos pode-se fazer um pequeno programa e muito eficiente.


Inclua o seguinte código no procedimento CmdImpressão_Click( ) do formulário:


Private Sub CmdImpressão_Click()
On Error GoTo aviso
Dim Célula As Excel.Range
Dim StrData, i, nLinha, Col

If Me.BoxDia = "" Then
MsgBox "Digite um dia para impressão", vbInformation, "Agenda"
Else
AGENDA.Range("A1") = Day(Me.BoxDia)
AGENDA.Range("B2") = UCase(Format(Me.BoxDia, "MMMM"))
AGENDA.Range("D2") = UCase(Dia_Semana(Me.BoxDia))
i = 1
For Each Célula In ThisWorkbook.Sheets("datas").Range("nDatas").Cells
StrData = Célula.Value
i = i + 1
If CDate(Me.BoxDia) = CDate(StrData) Then
nLinha = i
For Col = 1 To 24
AGENDA.Range("B" & Col + 4) = Plan2.Cells(i, Col + 1)
Next Col
Exit For
End If
Next
AGENDA.Copy
End If

Exit Sub
aviso:
If Err.Number = 18 Then
Else
MsgBox Err.Number & "-" & Err.Description
End If
End Sub

Detalhamento do código no procedimento CmdImpressão_Click( ) do formulário:

Como nos procedimentos Incluir_Alterar_Click( ) e PesquisarData utilizamos aqui a instrução For Each Next para percorrer a tabela de datas e encontrando a data digitada no BoxDia o sistema preencherá a planilha Agenda e fará uma cópia da mesma para que usuário possa vizualiza-la e se desejar até imprimir o relatório. Dentro do procedimento CmdImpressão_Click( ) incluímos uma novi-
dade: a função Dia_Semana.


Esta função examina o dia da semana (WeekDay) do BoxDia e converte para extenso.

Como Ativar um Suplemento ?

Quando se converte um arquivo ".xls" para suplemento ".xla" temos que ter algum meio de ativar o aplicativo, pois como já esclarecemos, um suplemento do Excel se torna invisível ao nossos olhos, apesar de estar ativado. Existem duas maneiras de faze-lo, ou criando um botão na barra de ferramentas ou um itém de menu na barra de menus. No aplicativo agenda vamos inserir um itém de menu para poder ativar-lo e podemos opera-lo.

Inserindo um Item de Menu

No Editor de VBA, no menu inserir escolha Módulo. Temos que criar dois códigos, um para criar um item de menu e outro para excluir este mesmo item, ou seja quando se ativa um suplemento o item de menu será criado e quando se desativa um suplemento exclui-se este item de menu.
Para se incluir um item de menu digite o seguinte procedimento no Módulo 1 que você acabou se inserir:
Sub CriarItemMenu()
Dim ctlMenuItem As CommandBarControl
Dim intCount As Integer
Dim cBut As CommandBarButton
Dim strBarName As String
Dim lngID As Long

Call ExcluirItemMenu

strBarName = QUAL_MENU
Do

Select Case intCount
Case 0
lngID = 846
Case 1
lngID = 3823
Case 2
lngID = 748
Case 3
lngID = 3
End Select

Set ctlMenuItem = Application.CommandBars(strBarName). _
FindControl(Id:=lngID, recursive:=True)
Loop Until (Not ctlMenuItem Is Nothing) Or intCount = 3

If Not ctlMenuItem Is Nothing Then
Set cBut = ctlMenuItem.Parent.Controls.Add(before:=ctlMenuItem.Index + 1, _
temporary:=True)
With cBut
.FaceId = 125
.Caption = TÍTULO_ITEM_MENU
.OnAction = ThisWorkbook.Name & MACRO_ITEM_MENU
.Tag = TAG_ITEM_MENU
End With
End If
End Sub

Para que um item de menu seja corretamente alocado em um menu é necessário que o código avalie o menu verificando se já não existe um item de menu com as mesmas características, para se evitar tal falha dentro do código CriarItemMenu ( ) inseri o código ExcluiItemMenu ( ), ou seja o sistema primeiro excluirá um item de menu chamado "Minha Agenda Pessoal" para depois inclui-lo.
Segue abaixo código do procedimento ExcluirItemMenu:

Sub ExcluirItemMenu()

Dim ctlMenu As CommandBarControl
Dim ctlMenuItem As CommandBarControl
Dim strBarName As String


strBarName = QUAL_MENU
Set ctlMenuItem = Application.CommandBars(strBarName). _
FindControl(Tag:=TAG_ITEM_MENU, recursive:=True)
If Not ctlMenuItem Is Nothing Then ctlMenuItem.Delete
End Sub

Com o código para criação do item de menu pronto, como fazer que o sistema o leia automaticamente ? simples, vamos utilizar o evento de pasta Workbook_Open( ), ou seja todos procedimentos digitados no Workbook_Open são reconhecidos toda vez que o suplemento é ativado.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Módulo1.ExcluirItemMenu
End Sub

Private Sub Workbook_Open()
Módulo1.CriarItemMenu
End Sub

Convertendo um Arquivo XLS em Suplemento(XLA)

Esta é a parte mais simples, converter um arquivo XLS em XLA. Basta ir no Menu Arquivo(F12)item de menu Salvar Como , e no DropDown Salvar Tipo Como escolha Suplemento do Microsoft Excel.

Você pode salvar seu suplemento em quanquer diretório, mas se você quizer que seu arquivo fique visivel em na caixa de dialogo padrão do office chamada "suplementos" salve seu arquivo no diretorio "Bibliote" localizado dentro o SubDiretório Office,. Microsoft Office em Arquivos de Programas.


Depois de salva seu 1ºsuplemento, basta ativar a caixa de dialogo "suplementos".

Abaixo coloco todo o codigo da nossa agenda.


Modulo 1

Public Const QUAL_MENU As String = "Worksheet Menu Bar"
Public Const TÍTULO_ITEM_MENU As String = "&Minha Agenda Pessoal"
Public Const MACRO_ITEM_MENU As String = "!ExibirFormulário"
Public Const TAG_ITEM_MENU As String = "AGENDA"

Sub CriarItemMenu()
Dim ctlMenuItem As CommandBarControl
Dim intCount As Integer
Dim cBut As CommandBarButton
Dim strBarName As String
Dim lngID As Long

Call ExcluirItemMenu

strBarName = QUAL_MENU
Do

Select Case intCount
Case 0
lngID = 846
Case 1
lngID = 3823
Case 2
lngID = 748
Case 3
lngID = 3
End Select

Set ctlMenuItem = Application.CommandBars(strBarName). _
FindControl(Id:=lngID, recursive:=True)
Loop Until (Not ctlMenuItem Is Nothing) Or intCount = 3

If Not ctlMenuItem Is Nothing Then
Set cBut = ctlMenuItem.Parent.Controls.Add(before:=ctlMenuItem.Index + 1, _
temporary:=True)
With cBut
.FaceId = 125
.Caption = TÍTULO_ITEM_MENU
.OnAction = ThisWorkbook.Name & MACRO_ITEM_MENU
.Tag = TAG_ITEM_MENU
End With
End If
End Sub
Sub ExcluirItemMenu()

Dim ctlMenu As CommandBarControl
Dim ctlMenuItem As CommandBarControl
Dim strBarName As String


strBarName = QUAL_MENU
Set ctlMenuItem = Application.CommandBars(strBarName). _
FindControl(Tag:=TAG_ITEM_MENU, recursive:=True)
If Not ctlMenuItem Is Nothing Then ctlMenuItem.Delete
End Sub

Sub ExibirFormulário()
FrmAgenda.Show
End Sub


No Formulário

Private Function Dia_Semana(nDia As Date)
If WeekDay(nDia) = 1 Then
Dia_Semana = "Domingo"
ElseIf WeekDay(nDia) = 2 Then
Dia_Semana = "Segunda"
ElseIf WeekDay(nDia) = 3 Then
Dia_Semana = "Terça"
ElseIf WeekDay(nDia) = 4 Then
Dia_Semana = "Quarta"
ElseIf WeekDay(nDia) = 5 Then
Dia_Semana = "Quinta"
ElseIf WeekDay(nDia) = 6 Then
Dia_Semana = "Sexta"
ElseIf WeekDay(nDia) = 7 Then
Dia_Semana = "Sábado"
Else
Dia_Semana = "Desconhecido"
End If
End Function



Private Sub CmdImpressão_Click()
On Error GoTo aviso
Dim Célula As Excel.Range
Dim StrData, i, nLinha, Col

If Me.BoxDia = "" Then
MsgBox "Digite um dia para impressão", vbInformation, "Agenda"
Else
AGENDA.Range("A1") = Day(Me.BoxDia)
AGENDA.Range("B2") = UCase(Format(Me.BoxDia, "MMMM"))
AGENDA.Range("D2") = UCase(Dia_Semana(Me.BoxDia))
i = 1
For Each Célula In ThisWorkbook.Sheets("datas").Range("nDatas").Cells
StrData = Célula.Value
i = i + 1
If CDate(Me.BoxDia) = CDate(StrData) Then
nLinha = i
For Col = 1 To 24
AGENDA.Range("B" & Col + 4) = Plan2.Cells(i, Col + 1)
Next Col
Exit For
End If
Next
AGENDA.Copy
End If

Exit Sub
aviso:
If Err.Number = 18 Then
Else
MsgBox Err.Number & "-" & Err.Description
End If
End Sub

Private Sub CmdIncluir_Click()
Me.Incluir_Alterar
Me.PesquisarData
End Sub

Private Sub CmdSair_Click()
End
End Sub

Private Sub combohora_Click()
Me.PesquisarData
End Sub


Private Sub boxdia_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.BoxDia = "" Then
Else
If IsDate(Me.BoxDia) Then
Me.ComboHora.ListIndex = -1
Me.BoxDia = Format(Me.BoxDia, "dd/mm")
Me.ComboHora.ListIndex = 0
Else
MsgBox "Data inválida...", vbCritical, "Minhas tarefas e lembretes.."
Cancel = True
End If
End If
End Sub


Private Sub UserForm_Activate()
Dim Cont
Me.ComboHora.Clear
For Cont = 1 To 24
Me.ComboHora.AddItem Format(Cont & ":00", "h:mm")
Next
Me.BoxDia = Format(Date, "dd/mm")
End Sub

Sub PesquisarData()
Dim Célula As Excel.Range
Dim StrData, i, nLinha, Cont
i = 1
Me.BoxAnotação = ""
Me.BoxResumo = ""
For Each Célula In ThisWorkbook.Sheets("datas").Range("nDatas").Cells
StrData = Célula.Value
i = i + 1
If CDate(Me.BoxDia) = CDate(StrData) Then
nLinha = i
Me.BoxAnotação = Plan2.Cells(i, Me.ComboHora.ListIndex + 2)
For Cont = 1 To 24
Me.BoxResumo = Me.BoxResumo & Chr(10) & Plan2.Cells(1, Cont + 1) & _
":00 - " & Plan2.Cells(i, Cont + 1)
Next
Exit For
End If
Next
End Sub

Sub Incluir_Alterar()
Dim Célula As Excel.Range
Dim StrData, i, nLinha
i = 1
For Each Célula In ThisWorkbook.Sheets("datas").Range("nDatas").Cells
StrData = Célula.Value
i = i + 1
If CDate(Me.BoxDia) = CDate(StrData) Then
nLinha = i
Plan2.Cells(i, Me.ComboHora.ListIndex + 2) = Me.BoxAnotação
Exit For
End If
Next
End Sub

E em Esta_Pasta_de_Trabalho

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Módulo1.ExcluirItemMenu
End Sub

Private Sub Workbook_Open()
Módulo1.CriarItemMenu
End Sub