无类模块纯窗体日期拾取自动适应屏幕位置

mrgood88 · 发表于 2017-2-16 22:42

本帖最后由 mrgood88 于 2017-2-16 22:44 编辑

很久没来发表作品了，以前做过一个类模块的日期拾取模块，引用时要复制几处代码，这回花了点时间做了一个纯窗体的，所有代码都在日历窗体里
特色如下：
1、无类模块，全部代码在MDATE日历窗体内
2、年月加减用SpinButton左后单按钮分开的效果，简洁，数字变动快，按下鼠标会一直变动
3、随鼠标移动数字背景变色
4、符合中国人习惯的周一为第一天
5、加入“上”，“今”两个小按钮，快捷定位到，单元格中录入的上个日期，或今天日期，更适应平常录入习惯
6、冻结窗口时，日历窗体也能自动适应单元格位置，在激活单元格上下或左右完全显示出来，自动调整（这个不是我的代码，谢过）

我的日历1.jpg

我的界面参考论坛里的界面

纯窗体无类模块日期拾取自动适屏（MRGOOD88）.rar (56.81 KB, 下载次数: 764)

吴狄 · 发表于 2017-2-16 23:53

谢谢分享，非常好用

鄂龙蒙 · 发表于 2017-2-17 07:41

谢谢分享，学习并收藏。

百度不到去谷歌 · 发表于 2017-2-17 08:09

好东西一直不爱用日历控件因为兼容性问题太麻烦有了这个就可以用了

huang1314wei · 发表于 2017-2-17 08:19

这个不顶不是人，论坛吃白食的多，像这样的技术分享越来越少了

mqjbayni · 发表于 2017-2-17 10:18

非常好用，谢谢。
另弱弱地问一下，如何让日历仅在某列，或指定区域弹出，期待回复

mrgood88 · 发表于 2017-2-17 12:30

mqjbayni 发表于 2017-2-17 10:18
非常好用，谢谢。
另弱弱地问一下，如何让日历仅在某列，或指定区域弹出，期待回复

加在这里
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Selection, Union(Range("a1:a2"), Range("c5:c8"))) Is Nothing Then '在这里指定要显示窗体的区域

'日历窗体加载
End If
End Sub

mrgood88 · 发表于 2017-2-17 12:31

mrgood88 发表于 2017-2-17 12:30
加在这里
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next

只加红色的两句到这个过程前后，中间还是原先的代码

考试加油站 · 发表于 2017-2-17 18:11

谢谢分享谢谢分享

№▁▃风筝﹋ · 发表于 2017-2-17 20:09

顶一下。。

		自动登录	找回密码
密码			免费注册

[原创] 无类模块纯窗体日期拾取自动适应屏幕位置

评分

评分