ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 10812|回复: 21

[原创] EXCEL VBA 一键输入日期控件

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-18 10:08 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 !!!橄榄树 于 2020-4-30 08:46 编辑

EXCEL VBA 一键输入日期控件
       VB 一键输入日期控件
EXCEL VBA一键输入日期控件编制介绍(1)
    一、软件目的
    因许多日历控件又大又不好用,一般要三至五次击键才能输入日期,本人独创自感应鼠标滚动循环输入数字文本框精美日历。鼠标移动至年或月框中, 滚动鼠标自感应循环输入数字,一键输入任意日期,极大提高日期输入速度。为了精益求精,请提改进建议,或提供更先进的本类控件。谢谢!!!
    二、软件设计涉及的知识点及难点
    1.日期函数      2.鼠标移动函数        3.月份自动感应鼠标滚动循环输入算法

    4.日期控件类组  5.窗体最小化至任务栏
    三、软件设计步骤
    1.插入窗体,窗体名称:精美日历,窗体如下图,
插入控件,其中 2020  和 01  是文本框控件, 6个框架控件,其它全是标签控件。













EXCEL VBA一键输入日期控件设计时窗体.png
EXCEL VBA一键输入日期控件运行后窗体.png

1键输入日期适用32位机WIN7.rar

190.82 KB, 下载次数: 552

评分

5

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-20 15:20 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
附件改进更新!

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-20 16:09 | 显示全部楼层
本帖最后由 !!!橄榄树 于 2020-3-20 20:11 编辑

陆续发表中



TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-21 09:44 | 显示全部楼层
本帖最后由 !!!橄榄树 于 2020-3-21 09:55 编辑

    EXCEL VBA一键输入日期控件,是在十多年前的 VB一键输入日期控件的基础上转换而来的,VB和VBA有很多地方不同,特别是API和类函数转换难度较大,不知是否有朋友关心阅读,提问或提出宝贵意见,在我有空能回答的情况下,我会一一回答,谢谢!
EXCEL VBA一键输入日期控件编制介绍(2)
    三、软件设计步骤
    1.插入窗体,窗体名称:精美日历,窗体如下图,插入控件,其中 2020  和 01  是文本框控件, 6个框架控件,其它全是标签控件
    2.插入类模块,类模块名称:cLB, 类模块代码如下:
Public WithEvents MLB AsMSForms.Label '标签控件类
Public Sub Init(cLB AsMSForms.Label)
    Set MLB = cLB '初始化,将控件绑定到类
End Sub
Private Sub MLB_Click() '控件的Click事件
    LH = MLB.Caption: ID = Mid(MLB.Name, 6, 2)
    精美日历.日 = 精美日历.日 + 1
   '精美日历.日 = 精美日历.Controls("Label" & ID)
End Sub
Private SubClass_Terminate()
    Set MLB = Nothing '注销类
End Sub
    4. Workbook代码
Private Sub Workbook_Open()   
    精美日历.Show 0
End Sub

EXCEL VBA一键输入日期控件.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-22 09:50 | 显示全部楼层
本帖最后由 !!!橄榄树 于 2020-3-22 16:05 编辑

EXCEL VBA一键输入日期控件编制介绍(3)
    三、软件设计步骤
    1.插入窗体,窗体名称:精美日历,窗体如下图,插入控件,其中 2020  和 01  是文本框控件, 6个框架控件,其它全是标签控件
    2.插入类模块,类模块名称:cLB
    3.插入普通模块,模块名称:模块1, 模块代码如下:
Private Declare PtrSafeFunction CallWindowProc Lib "user32" Alias _
    "CallWindowProcA" (ByVallpPrevWndFunc As Long, ByVal Hwnd As Long, _
    ByVal Msg As Long, ByVal wParam As Long,ByVal lParam As Long) As Long
Private Declare PtrSafeFunction SetWindowLong Lib "user32" Alias "SetWindowLongA"_  
(ByVal Hwnd As Long, ByVal nIndex AsLong, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC =-4
Private Const WM_MOUSEWHEEL= &H20A '滚动
Global lpPrevWndProcA AsLong
Public bMouseFlag As Boolean'鼠标事件激活标志
Public TX, IMG As String,UpDw, Labid, ID, LH, SB, SD As Integer '定义全局变量
Public Sub HookMouse(ByValHwnd As Long)
    lpPrevWndProcA = SetWindowLong(Hwnd,GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookMouse(ByValHwnd As Long)
    SetWindowLong Hwnd, GWL_WNDPROC,lpPrevWndProcA
End Sub
Private FunctionWindowProc(ByVal hw As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long)As Long
    Select Case uMsg
        Case WM_MOUSEWHEEL '滚动
            Dim wzDelta, wKeys As Integer
            'wzDelta传递滚动的快慢,该值小于零表示滚轮向后滚动(朝用户方向)
            '大于零表示滚轮向前滚动(朝显示器方向)
            wzDelta = HIWORD(wParam)
            'wKeys指出是否有CTRL=8、SHIFT=4、鼠标键
            '(左=2、中=16、右=2、附加)按下,允许复合
            wKeys = LOWORD(wParam)
           '--------------------------------------------------
            If wzDelta < 0 Then '朝用户方向
                精美日历.DataDown
            Else                '朝显示器方向
                精美日历.DataUp
            End If
            '--------------------------------------------------
        Case Else
            WindowProc =CallWindowProc(lpPrevWndProcA, hw, uMsg, wParam, lParam)
    End Select
End Function
Private FunctionHIWORD(LongIn As Long) As Integer
     HIWORD = (LongIn And &HFFFF0000) \&H10000 '取出32位值的高16位
End Function
Private FunctionLOWORD(LongIn As Long) As Integer
     LOWORD = LongIn And &HFFFF&                '取出32位值的低16位
End Function

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-23 08:15 | 显示全部楼层
附件改进更新!

一键输入日期控件.rar

62.81 KB, 下载次数: 444

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-29 09:38 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-3-29 12:48 | 显示全部楼层
有人看的,楼主做得很棒。
我有个问题,如何通过修改日期范围,更改SQL查询结果?

TA的精华主题

TA的得分主题

发表于 2020-3-29 16:41 | 显示全部楼层
楼主做得真是太好了,感觉压力好大,代码都不知道什么意思,

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-31 16:49 | 显示全部楼层
附件改进更新!

一键输入日期控件.rar

62.78 KB, 下载次数: 327

评分

1

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 15:58 , Processed in 0.066564 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表