极简日历，直接调用，写入单元格、窗体

cidanji

日历极简cidanji 无框、年箭头、ESC退出.rar (41.6 KB, 下载次数: 201)

2024-1-29 11:15 上传

点击文件名下载附件

snow653124

大善，正在找这类工具，自带的添加不上

mythqiu

micch 发表于 2024-1-21 10:10
有跟随单元格和控件的功能没？看过几个窗体定位的代码，都不是很通用

多年前论坛下载的。论坛资料太多，遇到好的东西必须要下载，收藏，搜索都不能解决问题

micch

mythqiu 发表于 2024-5-29 09:34
多年前论坛下载的。论坛资料太多，遇到好的东西必须要下载，收藏，搜索都不能解决问题

这种就没任何意义了，主要目的是看代码，学习如何设计，不是白嫖成品。

文件设了密码，还做了混淆，不管做的好不好，都没有看的欲望了。

PS.你这个文件里的窗体，看着非常眼熟，是我学习自己制作日历窗体的时候第二版，我还真不知道有人用和我一样的窗体，深感荣幸。

这是第二版


这是第三版

prome3

micch 发表于 2024-5-29 11:23
这种就没任何意义了，主要目的是看代码，学习如何设计，不是白嫖成品。

文件设了密码，还做了混淆 ...

70楼 gchao15


这里也是一样，搬了别人写的代码过来，VBA工程加密，内部代码混淆。不知道这代码混淆的意义和目的是什么，整得我都不知道该怎么回他了。

实际上那代码是一个外国人写的，源码有完整的、良好的注释，而且没有任何代码混淆。不知道为什么搬进EH论坛的人去掉了注释还混淆了代码。

zpy2

micch 发表于 2024-5-29 11:23
这种就没任何意义了，主要目的是看代码，学习如何设计，不是白嫖成品。

文件设了密码，还做了混淆 ...

试试AI吧，足够强大


Private WithEvents App As Application
Attribute App.VB_VarHelpID = -1
Private IsPickerVisible As Boolean

Private Sub Class_Initialize()
    On Error Resume Next
    Set App = Application
    IsPickerVisible = False
    On Error GoTo 0
End Sub

Private Sub Class_Terminate()
    ResetState
End Sub

Public Property Get PickerVisible() As Variant
    PickerVisible = IsPickerVisible
End Property

Public Property Let PickerVisible(ByVal NewValue As Variant)
    IsPickerVisible = NewValue
End Property

Private Sub HidePickerAndCleanup()
    ResetState
    PerformCleanupActions
End Sub

Private Sub ShowPicker()
    HidePickerAndCleanup
End Sub

Private Sub ResetState()
    IsPickerVisible = False
End Sub

Private Sub PerformCleanupActions()
    ResetState
    If ShouldPerformCleanupActions() Then
        PerformActualCleanup
    End If
End Sub

Private Function ShouldPerformCleanupActions() As Boolean
    On Error GoTo check_err
    Dim cellAbove As Range
    ShouldPerformCleanupActions = False
    If (ShouldCheckForCleanup) Then
        If TypeName(ActiveCell) = "Range" Then
            If VBA.IsDate(ActiveCell) Then
                ShouldPerformCleanupActions = True
            Else
                If ActiveCell <> "" Then Exit Function
                If ActiveCell.Row <> 1 Then
                    Set cellAbove = ActiveCell.Offset(-1, 0)
                    If InStr(1, cellAbove, "date", vbTextCompare) > 0 Or VBA.IsDate(cellAbove) Then
                        ShouldPerformCleanupActions = True
                    End If
                End If
            End If
        End If
    End If
check_err:
End Function

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    HidePickerAndCleanup
End Sub

Private Sub App_NewWorkbook(ByVal Wb As Workbook)
    ShowPicker
End Sub

Private Sub App_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
    ResetState
End Sub

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ResetState
End Sub

Private Sub App_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)
    PerformCleanupActions
End Sub

Private Sub App_SheetActivate(ByVal Sh As Object)
    HidePickerAndCleanup
End Sub

Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
    ShowPicker
End Sub

mythqiu

micch 发表于 2024-5-29 11:23
这种就没任何意义了，主要目的是看代码，学习如何设计，不是白嫖成品。

文件设了密码，还做了混淆 ...

代码没进入看过，感觉不错就一直使用了。当时下载也是在一个回帖下载的。

zpy2

micch 发表于 2024-5-29 11:23
这种就没任何意义了，主要目的是看代码，学习如何设计，不是白嫖成品。

文件设了密码，还做了混淆 ...

手工替换600多个，有点麻烦



ai还行

micch

用起来可以，毕竟拿来直接用。如果想套用到自己的项目里，就需要看代码，把需要的功能摘出来。但是这种混淆了的，实在没法看。学不到里面的代码

zpy2

zpy2 发表于 2024-5-29 12:35
手工替换600多个，有点麻烦

文件设了密码

如果需要作为组件，可以做成.xla加载项