Olá caríssimos leitores.
Sejam bem vindos mais uma vez ao meu site.
A dica de hoje será um exemplo bem prático, é claro, para aqueles leitores com conhecimento um pouco mais avançado sobre VBA. Contudo, ao final deste artigo, disponibilizarei o arquivo fonte, com todo o código utilizado e funcional, para todos poderem testar e aprender um pouco mais. Isso ajuda bastante aos iniciantes em VBA.
Vou mostrar como adicionar um calendário (do tipo folhinha de parede ou de mesa) dentro de uma planilha. Tudo isso, automaticamente, através de macro.
Esta macro, criará os grupos de meses, semanas, enfim, todos os blocos ajustados como num calendário mesmo. Com esta rotina, o leque de possibilidades de possíveis criações e adaptações é enorme. Unificar a um sistema de agenda, gerando relatórios neste formato, adaptar para imprimir apenas um mês específico, enfim. Podemos estudar bastante os fundamentos VBA.
Então vamos começar.
Acesse o ambiente VBA (ALT+F11) e adicione um módulo.
Neste módulo, escrevea o seguinte código:
Option Explicit
Sub CriarCalendario()
Dim lMonth As Long
Dim strMonth As String
Dim rStart As Range
Dim strAddress As String
Dim rCell As Range
Dim lDays As Long
Dim dDate As Date
Dim lPositionCell As Integer
Dim bEscreveData As Boolean
Dim lYear As Integer
Dim sYear As String
'Solicita o Ano para montar o calendário
sYear = InputBox("Informe o Ano para gerar o calendário:", "Criar Calendário", Year(Date))
'Sai da rotina se não for informado um ano válido
If (sYear = "" Or Not IsNumeric(sYear)) Then Exit Sub
lYear = CInt(sYear)
'Adiciona uma nova Planilha para criar o calendário
Worksheets.Add
ActiveSheet.Name = "Calendário " & lYear
'Ocultar as linhas de grade
ActiveWindow.DisplayGridlines = False
'Formata as colunas
With Cells
.ColumnWidth = 6
.Font.Size = 8
End With
'Cria o cabeçalho para os meses
For lMonth = 1 To 12 Step 3
Select Case lMonth
Case 1
Set rStart = Range("A1")
Case 4
Set rStart = Range("A9")
Case 7
Set rStart = Range("A17")
Case 10
Set rStart = Range("A25")
End Select
strMonth = MonthName(lMonth) 'Atribui o nome do mês na variável
'Mescla, auto-preenche e alinha os blocos dos meses
With rStart
.Value = UCase(strMonth)
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 6
.Font.Bold = True
With .Range("A1:G1")
.Merge
.BorderAround LineStyle:=xlContinuous
End With
'Preenche o cabeçalho dos dias da semana
For lDays = 1 To 7
.Cells(2, lDays).Value = UCase(WeekdayName(lDays, True))
Next lDays
.Range("A2:G2").BorderAround LineStyle:=xlContinuous
'Auto preenche demais meses ao lado
.Range("A1:G2").AutoFill Destination:=.Range("A1:U2")
End With
Next lMonth
'Preenche os meses com seus respectivos dias
For lMonth = 1 To 12
strAddress = Choose(lMonth, "A3:G8", "H3:N8", "O3:U8", _
"A11:G16", "H11:N16", "O11:U16", _
"A19:G24", "H19:N24", "O19:U24", _
"A27:G32", "H27:N32", "O27:U32")
lDays = 0
lPositionCell = 0
bEscreveData = False
Range(strAddress).BorderAround LineStyle:=xlContinuous
'Adiciona os dias
For Each rCell In Range(strAddress)
lDays = lDays + 1
lPositionCell = lPositionCell + 1
dDate = DateSerial(lYear, lMonth, lDays)
If bEscreveData = False Then
If Weekday(dDate, vbSunday) = lPositionCell Then
bEscreveData = True
Else
bEscreveData = False
lDays = 0
End If
End If
If bEscreveData = True Then
If Month(dDate) = lMonth Then 'Se for uma data válida
With rCell
.Value = dDate
.NumberFormat = "dd"
End With
End If
End If
Next rCell
Next lMonth
'Formatação condicional para o dia de hoje.
With Range("A1:U32")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=HOJE()"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 11
.HorizontalAlignment = xlCenter
End With
End Sub
Salve e retorne para a sua planilha.
Você poderá chamar a macro CriarCalendario() adicionando um botão na planilha com ação linkada a ela ou teclando ALT+F8 e executando-a.
A rotina da macro irá solicitar o ano para gerar o calendário. Informe-o na caixa abaixo.
Clique em OK.
O resultado será como este.
Será criada uma nova planilha com o nome “Calendário AAAA”, onde AAAA é o Ano digitado.
Agora usem a criatividade para adaptá-los as suas necessidades.
Um abraço.
Realmente muito bom o seu site!
Cara, você esta de parabéns. Continue assim, e só tenderá a formar novos seguidores, e, por tabela, facilitar cada vez mais o acesso ao conhecimento.
Grande abraço!
FJ
ESSA MACRO ESTA COM ERRO….. OS DIAS DA SEMANA ESTAO INCORRECTOS…. O DE 2012 COMECA A UM DOMINGO E COM ESSA MACRO ESTA A COMECAR A UMA SEGUNDO 😉
CUMPS
CONTINUACAO DE BOM TRABALHO
Olá,
Estranho… Executei a macro agora e deu tudo certo.
Mas, valeu por comentar.
Um abraço,
Reinaldo
1 de janeiro de 2012 foi em um domingo, fiote… Presta atençao antes de criticar, ou clique no calendario que vem com o windows…