VBA

最新推荐文章于 2022-06-22 22:30:00 发布

vviking

最新推荐文章于 2022-06-22 22:30:00 发布

阅读量503

点赞数

文章标签： vba integer date textbox string

本文链接：https://blog.csdn.net/vviking/article/details/5660173

版权

Const DQPosition = "G1" '当前保存位置
Const CLASSCOL = 1   '系统相关分类列
Const CLASSCOUNTCOL = "A2" '分类个数位置
Const DATABASESHEET = "系统相关"    '系统相关 sheet

Const LastDate = "B2"   '上次新建记录日期
Const TodayCount = "B3" '今日记录数

Public iSaveCol As Long '保存行位置
Public wsClassSel As Worksheet '分类选择的worksheet
Public iSucessFlg As Integer '保存成功标志

Private Sub ComboBox1_Change()
    Dim strClass As String
    Dim ws As Worksheet

    Set ws = Worksheets(DATABASESHEET)
    strClass = InsertForm.ComboBox1.Text

    If strClass <> "" Then
        Set wsClassSel = Worksheets(strClass)
        iSaveCol = wsClassSel.Range(DQPosition).Value
    End If

End Sub

'保存操作
'保存文本框内容
Private Sub CommandButton1_Click()
    Call SaveFun
End Sub
'清空操作
'清空文本框的内容
Private Sub CommandButton2_Click()
    TextBox1.Text = ""
    TextBox1.SetFocus
End Sub

' 取消操作
Private Sub CommandButton3_Click()
    Call CancelFun
End Sub
'取消方法
Private Sub CancelFun()
    If InsertForm.TextBox1.Text = "" Then
        Me.Hide
    Else
        If iSucessFlg = 1 Then   '保存过
            If InsertForm.TextBox1.Text <> wsClassSel.Cells(iSaveCol, 4) Then '内容变更
                x = MsgBox("内容未保存！" & vbCrLf & "是否保存？", vbYesNoCancel, "取消提示消息")
                If x = vbYes Then
                    Call SaveFun
                    Call TodayRecordCount '今日记录数
                    Me.TextBox1.Text = ""
                    Me.Hide
                ElseIf x = vbCancel Then
                    Me.TextBox1.SetFocus
                Else
                    Call TodayRecordCount '今日记录数
                    Me.TextBox1.Text = ""
                    Me.Hide
                End If
            Else
                Call TodayRecordCount '今日记录数
                Me.TextBox1.Text = ""
                Me.Hide
            End If
        Else
            x = MsgBox("内容未保存！" & vbCrLf & "是否保存？", vbYesNoCancel, "取消提示消息")
            If x = vbYes Then
                Call SaveFun
                'Call TodayRecordCount '今日记录数
                'Me.TextBox1.Text = ""
                'Me.Hide
            ElseIf x = vbCancel Then
                Me.TextBox1.SetFocus
            Else
                Me.TextBox1.Text = ""
                Me.Hide
            End If
        End If
    End If
End Sub

'保存方法
Private Sub SaveFun()
    Dim iCounter As Integer      '保存行位置
    Dim ws As Worksheet

    Set ws = Worksheets(DATABASESHEET)

    If InsertForm.TextBox1.Text = "" Then
        x = MsgBox("内容为空！", vbOKOnly, "保存提示消息")
        Me.TextBox1.SetFocus
    ElseIf InsertForm.ComboBox1.Text = "" Then
        x = MsgBox("请选择分类", vbOKCancel, "保存提示消息")
        If x = vbOK Then
            InsertForm.ComboBox1.SetFocus
        Else
            InsertForm.TextBox1.SetFocus
        End If
    Else
        '保存内容
        iCounter = iSaveCol                       '当前保存位置
        wsClassSel.Cells(iCounter, 1) = iCounter - 1 '序号
        wsClassSel.Cells(iCounter, 2) = Date & " " & Time '日期
        'wsClassSel.Cells(iCounter, 3) = DQPosition + 1 '用户 **
        wsClassSel.Cells(iCounter, 4) = Me.TextBox1.Text   '内容

        '当前保存位置
        wsClassSel.Range(DQPosition) = iCounter + 1

        '文件保存
        ThisWorkbook.Save

        '保存成功标记
        iSucessFlg = 1

        '提示框
        x = MsgBox("新建备忘记录保存成功", vbOKOnly, "保存成功提示消息")

    End If

End Sub
Private Sub TodayRecordCount()
Dim ws As Worksheet

Set ws = Worksheets(DATABASESHEET)

    '今日记录数
    If ws.Range(LastDate) = Date Then
       ws.Range(TodayCount).Value = ws.Range(TodayCount).Value + 1
    Else
        ws.Range(LastDate) = Date
        ws.Range(TodayCount).Value = 1
    End If

    '文件保存
    ThisWorkbook.Save

End Sub

Private Sub Label4_Click()

End Sub

Private Sub CounteLabel_Click()
Call TodayRecordCount '今日记录数
End Sub

Private Sub UserForm_Activate()
    Call ClassListInitialize   '分类列表初始化
    Call LabelInitialize       ' Label初始化

    InsertForm.TextBox1.SetFocus '焦点初始化

End Sub

Private Sub UserForm_Initialize()
'Call ClassListInitialize '分类列表初始化
'Call LabelInitialize ' Label初始化
End Sub

Public Sub LabelInitialize()
Dim iTodayCount As Integer
Dim ws As Worksheet

    Set ws = Worksheets(DATABASESHEET)

    '保存成功标志
    iSucessFlg = 0

    'DateLabel 日期初始化
    InsertForm.DateLabel.Caption = Date

    'WeekLabel 星期初始化
    InsertForm.WeekLabel.Caption = WeekdayName(Weekday(Date))

    'CounteLabel 个数初始化
    'LastDate TodayCount
    If ws.Range(LastDate) = "" Then
        ws.Range(LastDate) = Date
        iTodayCount = 1
        ws.Range(TodayCount).Value = 0
    Else
        If ws.Range(LastDate) = Date Then
           iTodayCount = ws.Range(TodayCount).Value + 1
        Else
            iTodayCount = 1
        End If
    End If
    InsertForm.CounteLabel.Caption = iTodayCount

End Sub
Private Sub ClassListInitialize()
    Dim iClassCounter As Long         '表示行数时，应该习惯设成长整型
    Dim i As Long
    Dim ws As Worksheet

    Set ws = Worksheets(DATABASESHEET)
    'l = ws.Range("A65536").End(xlUp).Row
    iClassCounter = ws.Range(CLASSCOUNTCOL).Value


    For i = 3 To iClassCounter + 2
        InsertForm.ComboBox1.AddItem (ws.Cells(i, CLASSCOL))
    Next
End Sub