Baixe o app para aproveitar ainda mais
Prévia do material em texto
Como criar um calendário 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 2015 + agendador de tarefas e de contas a pagar, clique aqui. 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. Veja como ficará:
Compartilhar