EXCEL VBA开发单元格日历选择_vba制作日期选择器源码-CSDN博客

本文链接：https://blog.csdn.net/shaochuan_2008/article/details/124892163

本文介绍如何使用VBA在Excel中创建一个随单元格位置变化的日历选择器，选中日期后能自动输入指定单元格，并提供了一个示例代码。此外，还探讨了如何配合代码实现日期选择窗体的定制。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

一、需求概述

想在EXCEL中使用VBA开发一个日历选择，选中日期后自动将日期（如：2022年10月20日）输入到单元格中，并且弹窗在指定单元格的下方。

二、效果展示

以下是基于个人开发的一个任务日志案例。

三、代码开发如下（WIN10环境下）


'----------------------------------------------------------------------------------------------------------------------
'用来控制窗口跟随单元格位置
'如果系统是64位，则必须加上PtrSafe在Function前面，32位不用
Option Explicit
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, _
        ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
'---------------------------------------------------------------------------------------------------------------------


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lHwnd As Long
    Dim lDC As Long
    Dim lCaps As Long
    Dim lngLeft As Long
    Dim lngTop As Long
    Dim sngPiexlToPiont As Single
    Const lLogPixelsX = 88

    If Target.Count = 1 Then
        If Target.Row > 3 And Target.Row < 1000 And Target.Column = 2 Or Target.Column = 4 Then
'            Frm_Riqi.Show 0
'            Frm_Riqi.Top = Application.Top + Target.Top
'            Frm_Riqi.Left = Application.Left + Target.Left

'----------------------------------------------------------------------------------------------------------------------
'用来控制窗口跟随单元格位置
            lDC = GetDC(0)
            lCaps = GetDeviceCaps(lDC, lLogPixelsX)
            sngPiexlToPiont = 72 / lCaps * (100 / ActiveWindow.Zoom)
            lngLeft = CLng(ActiveWindow.PointsToScreenPixelsX(0) + (Target.Offset(1, 0).Left / sngPiexlToPiont))
            lngTop = CLng(ActiveWindow.PointsToScreenPixelsY(0) + (Target.Offset(1, 0).Top / sngPiexlToPiont))
            Frm_Riqi.StartUpPosition = 0
            lHwnd = FindWindow(vbNullString, Frm_Riqi.Caption)
            MoveWindow lHwnd, lngLeft, lngTop, 780, 750, True
'----------------------------------------------------------------------------------------------------------------------
            Frm_Riqi.Show 0
        Else
            Unload Frm_Riqi
        End If
    End If
End Sub

还要再开发设置一个日期的窗体，代码案例参考如下，可以直接下载使用：

https://download.csdn.net/download/shaochuan_2008/85425448https://download.csdn.net/download/shaochuan_2008/85425448