đź“… Excel Date Picker (VBA)
Um seletor de datas simples e funcional feito 100% em VBA, sem controles ActiveX nem suplementos externos. Ao clicar (ou dar duplo-clique) em cĂ©lulas de data, um calendário Ă© exibido para escolher o dia. CompatĂvel com todas as versões do Excel para Windows e Mac.
🧩 Estrutura do projeto Arquivo Função CBtn.cls Classe auxiliar que intercepta o clique em cada botão do calendário. frmDatePicker.frm UserForm que constrói o calendário dinamicamente (sem layout fixo). modDatePicker.bas Módulo principal com a função pública ShowDatePickerFor. worksheet_code_to_paste.txt Código do evento da planilha que define onde o calendário aparece. 🚀 Como usar
Abra o Editor VBA com Alt + F11.
Importe os arquivos .cls, .frm, .frx e .bas (menu: Arquivo → Importar arquivo).
Na planilha desejada (ex.: Planilha1), cole o código do evento que está em worksheet_code_to_paste.txt.
Salve o arquivo como .xlsm (habilitado para macros).
Teste: selecione uma célula entre D3:D10000 ou G3:G10000 — o calendário será exibido automaticamente.
đź’ˇ Dicas
Se aparecer “Tipo definido pelo usuário não definido”, ative a referência Microsoft Forms 2.0 Object Library (inserir qualquer UserForm resolve).
Quer acionar sĂł com duplo clique? Substitua Worksheet_SelectionChange por Worksheet_BeforeDoubleClick.
Pode ajustar facilmente o intervalo de células no evento da planilha (D3:D10000, G3:G10000).
O calendário formata automaticamente a célula como dd/mm/yyyy.
- Classe CBtn (Class Module)
No VBA: Inserir → Módulo de Classe → renomeie para CBtn → cole:
Option Explicit Public WithEvents Btn As MSForms.CommandButton Public Parent As frmDatePicker
Private Sub Btn_Click() Parent.DayClicked Btn End Sub
- UserForm frmDatePicker
No VBA: Inserir → UserForm → no campo (Name) coloque frmDatePicker → cole este código no módulo do UserForm:
Option Explicit
Private btns() As MSForms.CommandButton Private handlers As Collection Private shownYear As Long, shownMonth As Long Private targetCell As Range
Public Sub OpenFor(ByVal tgt As Range) Set targetCell = tgt If IsDate(tgt.Value) Then shownYear = Year(CDate(tgt.Value)) shownMonth = Month(CDate(tgt.Value)) Else shownYear = Year(Date) shownMonth = Month(Date) End If Me.Caption = "Escolha a data" BuildUI BuildCalendar DateSerial(shownYear, shownMonth, 1) End Sub
Private Sub BuildUI() Static built As Boolean If built Then Exit Sub
Dim i As Long, r As Long, c As Long
Dim lbl As MSForms.Label
Dim bPrev As MSForms.CommandButton, bNext As MSForms.CommandButton
Dim names
Me.Width = 260
Me.Height = 230
' Cabeçalho: mês/ano e navegação
Set lbl = Me.Controls.Add("Forms.Label.1", "lblMonth", True)
With lbl
.Left = 70: .Top = 6: .Width = 120: .Height = 18
.TextAlign = fmTextAlignCenter: .Font.Bold = True
End With
Set bPrev = Me.Controls.Add("Forms.CommandButton.1", "btnPrev", True)
With bPrev: .Caption = "<": .Left = 15: .Top = 4: .Width = 30: .Height = 20: End With
Set bNext = Me.Controls.Add("Forms.CommandButton.1", "btnNext", True)
With bNext: .Caption = ">": .Left = 215: .Top = 4: .Width = 30: .Height = 20: End With
' Cabeçalhos dos dias (Dom..Sáb)
names = Array("D", "S", "T", "Q", "Q", "S", "S")
Dim k As Long
For k = 0 To 6
Set lbl = Me.Controls.Add("Forms.Label.1", "lblW" & k, True)
With lbl
.Caption = names(k)
.Left = 15 + k * 34
.Top = 28
.Width = 30: .Height = 14
.TextAlign = fmTextAlignCenter
.Font.Bold = True
End With
Next
' Grade 6x7 de botões de dias
ReDim btns(1 To 42)
Set handlers = New Collection
Dim h As CBtn
For i = 1 To 42
Set btns(i) = Me.Controls.Add("Forms.CommandButton.1", "btn" & i, True)
r = (i - 1) \ 7: c = (i - 1) Mod 7
With btns(i)
.Width = 30: .Height = 22
.Left = 15 + c * 34
.Top = 46 + r * 24
.Caption = "": .TakeFocusOnClick = False
End With
Set h = New CBtn
Set h.Btn = btns(i)
Set h.Parent = Me
handlers.Add h
Next
built = True
End Sub
Private Sub BuildCalendar(ByVal firstDay As Date) Dim i As Long, idx As Long, startCol As Integer, daysIn As Integer
Me.Controls("lblMonth").Caption = Format(firstDay, "mmmm yyyy")
startCol = Weekday(firstDay, vbSunday) ' 1..7
daysIn = Day(DateSerial(Year(firstDay), Month(firstDay) + 1, 0))
' Limpa botões
For i = 1 To 42
With btns(i)
.Caption = "": .Enabled = False: .Tag = "": .BackColor = &H8000000F
End With
Next
' Preenche dias do mĂŞs
idx = startCol
For i = 1 To daysIn
With btns(idx)
.Caption = CStr(i)
.Enabled = True
.Tag = CStr(DateSerial(Year(firstDay), Month(firstDay), i))
If DateSerial(Year(firstDay), Month(firstDay), i) = Date Then .BackColor = &H00C0FFC0
End With
idx = idx + 1
Next
End Sub
' Navegação Private Sub btnPrev_Click() shownMonth = shownMonth - 1 If shownMonth = 0 Then shownMonth = 12: shownYear = shownYear - 1 BuildCalendar DateSerial(shownYear, shownMonth, 1) End Sub
Private Sub btnNext_Click() shownMonth = shownMonth + 1 If shownMonth = 13 Then shownMonth = 1: shownYear = shownYear + 1 BuildCalendar DateSerial(shownYear, shownMonth, 1) End Sub
' Recebido do handler de clique Public Sub DayClicked(ByVal b As MSForms.CommandButton) If Len(b.Tag) > 0 Then If Not targetCell Is Nothing Then targetCell.Value = CDate(b.Tag) targetCell.NumberFormat = "dd/mm/yyyy" End If Unload Me End If End Sub
- MĂłdulo padrĂŁo modDatePicker
No VBA: Inserir → Módulo → renomeie para modDatePicker → cole:
Attribute VB_Name = "modDatePicker" Option Explicit
Public Sub ShowDatePickerFor(ByVal tgt As Range) On Error GoTo Fim Application.EnableEvents = False With frmDatePicker .OpenFor tgt .Show vbModal End With Fim: Application.EnableEvents = True End Sub
- Evento na planilha
DĂŞ duplo-clique na planilha desejada (ex.: Planilha1) e cole:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo sair If Target.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("D3:D10000,G3:G10000")) Is Nothing Then ShowDatePickerFor Target End If sair: End Sub ' (Opcional, menos intrusivo – duplo clique) 'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' If Not Intersect(Target, Range("D3:D10000,G3:G10000")) Is Nothing Then ' Cancel = True ' ShowDatePickerFor Target ' End If 'End Sub