fechar

Aprender Excel

APRENDER EXCEL

DICAS E NOVIDADES SOBRE EXCEL

Como criar um calendário mensal no Excel 2016, 2013 ou 2010

por: Maximiliano Meyer em VBA, no dia 21/09 | 15:06

Precisando inserir um calendário em sua planilha? Então você está no post certo.

Lembrando que este código irá inserir um calendário mensal de um mês e ano especificado por você. Caso deseje um código que crie um calendário anual na sua planilha, confira este outro código. Na verdade eu sugiro que você veja os 2 e escolha qual se adapta melhor às suas necessidades.

Lembrando que já está disponível para download nossa planilha calendário com agendador de contas para o ano de 2017. O download pode ser feito aqui.

O resultado será o seguinte:

Vamos começara criar esse calendário então. Logo que abrir a planilha aperte Alt+F11 para acessar o modo de edição e programação de macros. Agora dê um duplo clique em 'Esta_pasta_de_trabalho' e cole o seguinte código:

Sub CalendarioMensal()    

ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
Scenarios:=False
Application.ScreenUpdating = False
On Error GoTo MyErrorTrap
Range("a1:g14").Clear 'Esta será a área onde será inserido o calendário. Se você editar a área de inserção não esqueça de editar as células abaixo para não dar erro
MyInput = InputBox("Digite o mês e o ano do seu calendário:" & vbCrLf & "" & vbCrLf & "www.AprenderExcel.com.br")
    If MyInput = "" Then Exit Sub
       StartDay = DateValue(MyInput)
        If Day(StartDay) <> 1 Then
        StartDay = DateValue(Month(StartDay) & "/1/" & _
        Year(StartDay))
    End If

Range("a1").NumberFormat = "mmmm yyyy"

With Range("a1:g1")
    .HorizontalAlignment = xlCenterAcrossSelection
    .VerticalAlignment = xlCenter
    .Font.Size = 18
    .Font.Bold = True
    .RowHeight = 35
End With

With Range("a2:g2")
    .ColumnWidth = 11
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Orientation = xlHorizontal
    .Font.Size = 12
    .Font.Bold = True
    .RowHeight = 20
End With

Range("a2") = "Domingo"
Range("b2") = "Segunda"
Range("c2") = "Terça"
Range("d2") = "Quarta"
Range("e2") = "Quinta"
Range("f2") = "Sexta"
Range("g2") = "Sábado"

With Range("a3:g8")
   .HorizontalAlignment = xlRight
   .VerticalAlignment = xlTop
   .Font.Size = 18
   .Font.Bold = True
   .RowHeight = 21
End With

Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
DayofWeek = Weekday(StartDay)
CurYear = Year(StartDay)
CurMonth = Month(StartDay)
FinalDay = DateSerial(CurYear, CurMonth + 1, 1)

Select Case DayofWeek
   Case 1
   Range("a3").Value = 1
   Case 2
   Range("b3").Value = 1
   Case 3
   Range("c3").Value = 1
   Case 4
   Range("d3").Value = 1
   Case 5
   Range("e3").Value = 1
   Case 6
   Range("f3").Value = 1
   Case 7
   Range("g3").Value = 1
End Select

For Each cell In Range("a3:g8")
   RowCell = cell.Row
   ColCell = cell.Column
     If cell.Column = 1 And cell.Row = 3 Then
     ElseIf cell.Column <> 1 Then
          If cell.Offset(0, -1).Value >= 1 Then
            cell.Value = cell.Offset(0, -1).Value + 1
               If cell.Value > (FinalDay - StartDay) Then
               cell.Value = ""
               Exit For
           End If
     End If
   ElseIf cell.Row > 3 And cell.Column = 1 Then
      cell.Value = cell.Offset(-1, 6).Value + 1
         If cell.Value > (FinalDay - StartDay) Then
         cell.Value = ""
       Exit For
    End If
 End If
Next

For x = 0 To 5
Range("A4").Offset(x * 2, 0).EntireRow.Insert
     With Range("A4:G4").Offset(x * 2, 0)
         .RowHeight = 65
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlTop
         .WrapText = True
         .Font.Size = 10
         .Font.Bold = False
         .Locked = False
      End With
      With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlLeft)
         .Weight = xlThick
         .ColorIndex = xlAutomatic
      End With
      With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlRight)
         .Weight = xlThick
         .ColorIndex = xlAutomatic
      End With

Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
Weight:=xlThick, ColorIndex:=xlAutomatic
Next
      If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
          .Resize(2, 8).EntireRow.Delete
          ActiveWindow.DisplayGridlines = False

      ' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _ Atenção: ' Se você quiser bloquear seu calendário contra edições é só apagar as aspas vermelhas no início dessa frase e na frase abaixo
      ' Scenarios:=True
ActiveWindow.WindowState = xlMaximized
ActiveWindow.ScrollRow = 1
Application.ScreenUpdating = True

Exit Sub

MyErrorTrap:
    MsgBox "Provavelmente você não entrou os dados corretamente" _
    & Chr(13) & "" _
    & Chr(13) & "Digite o nome do mês" _
    & " (você pode usar a abreviação de 3 letras)" _
    & Chr(13) & "e 4 dígitos para o ano" _
    & Chr(13) & "" _
    & Chr(13) & "www.AprenderExcel.com.br"
    MyInput = InputBox("Digite o mês e o ano")
    If MyInput = "" Then Exit Sub
Resume

End Sub

Agora chegou a hora de testar. Clique no sinal de play na barra de tarefas da própria janela de edição do VBA. Se você já estiver fora da janela de edição é só apertar alt + F8 e executar a macro. Se você achar interessante pode criar também um botão para executar a macro sempre que desejar. Aprenda a fazer isso aqui.

Na janela que abrir insira o mês e o ano desejado, em uma linha única, sem vírgulas ou caracteres especiais. Por exemplo: Dezembro 2016. 

O nome do mês deve ser inserido no idioma que está o seu Office. Legal que você pode usar a abreviação de letras para cada mês: janeiro será jan, fevereiro será fev, etc.

É isso aí pessoal. Não esqueça de conferir o outro método de criar calendários e escolha o seu preferido.