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

Aprenda a inserir calendários mensais personalizados em seus projetos com esse código.

Por Maximiliano Meyer

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:

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

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. 

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

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.

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

relacionados

Participe
do nosso grupo
Grupo do Facebook Aprender Excel

recentes

O que ler em seguida

comentários

Carregar comentários
Siga nossas redes sociais