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

Olá pessoal. Hoje vamos resolver o problema de muita gente que pergunta por e-mail e nos comentários como adicionar um calendário em uma planilha do Excel 2013, já que ele não tinha a mesma funcionalidade "quase" automática do Excel 2007.

Bom, se você ainda usa o 2007, o método anterior ainda é válido, por isso corra e clique aqui. Agora, se você quiser baixar GRATUITAMENTE, nosso calendário pro ano de 2017 + agendador de tarefas e de contas a pagar, clique aqui.

Lembrando que o código apresentado na aula de hoje irá inserir um calendário anual de um determinado ano especificado por você. Caso deseje um código que crie um calendário mensal de um certo mês e ano 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.

Agora, se você está no Office 2010 ou 2013 vamos fazer o seguinte:

Logo que abrir a planilha aperte Alt+F11 para acessar o modo de edição e programação de macros. Agora vamos clicar com o direito em "VBAProject" e depois em "Inserir" e "Módulo".

Uma nova janela para inserção de código será aberta, nela você vai colar o seguinte texto, depois salvar e voltar ao Excel:

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

Ao voltar pro Excel vamos teclar Alt + F8, e na caixa que será aberta clicar em "Executar" (a função que acabamos de inserir "CalendarioDoAno" já deverá estar selecionada).

Para finalizar, uma nova caixa aparecerá, nela você escolherá o ano do seu calendário. Note que já irá aparecer o ano de 2015 automaticamente, mas você poderá colocar 2016, 2018, etc. O Excel irá criar o calendário de acordo com o ano que você pedir.