尝试在自动检查框后自动在多列中添加日期

时间:2018-05-04 05:24:54

标签: excel-vba date checkbox autofill vba

我正在尝试用她的T恤库存电子表格帮助我的母亲,这样她就可以在检查风格后获得复选框和日期。在网站上进行了数小时的视频和研究后,我尝试将这些代码组合在一起,但没有运气:

(来自网站:https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-mso_windows8-mso_2016/use-check-box-to-create-date-time-stamp/a466c68a-2440-4ce0-9a73-2abe73256a0b

Private Sub CheckBox1_Change() 
    Dim destSH As Worksheet 
    Dim rngDate As Range, rngTime As Range 
    Set destSH = ThisWorkbook.Sheets("Sheet2") 
    With destSH Set rngDate = .Range("E2") 
         Set rngTime = .Range("D2") 
    End With 
    If Me.CheckBox1.Value = True Then 
    With rngDate .Value = Date 
        .NumberFormat = "mm/dd/yyyy" 
    End With 
    With rngTime .Value = Now() 
        .NumberFormat = "hh:mm" 
    End With
    End If 
End Sub

和本网站:https://social.msdn.microsoft.com/Forums/office/en-US/9e6dd210-59db-4018-a0c2-6a60dc03aeb8/check-box-that-insert-todays-date-in-another-cell?forum=exceldev

     Private Sub Worksheet_Change(ByVal Target As Range)
     Dim cel As Range
     If Not Intersect(Range("C2:C100"), Target) Is Nothing Then
     Application.EnableEvents = False
     For Each cel In Intersect(Range("C2:C100"), Target)
        If cel.Value = "" Then
            cel.Offset(ColumnOffset:=1).ClearContents
        Else
            cel.Offset(ColumnOffset:=1).Value = Date
        End If
        Next cel
        Application.EnableEvents = True
        End If
        End Sub

这是我在尝试修复多个错误后最终得到的更改 -

        Private Sub CheckBox1_Change()
        Dim destSH As Worksheet
        Dim rngDate As Range

        Set destSH = ThisWorkbook.Sheets("Sheet")
        If Me.CheckBox1.Value = True Then

        With rngDate.Value = Date
        .NumberFormat = "mm/dd/yyyy"
        End With

        Set rngDate = Range("E2,E48")
        If Not Range("D2,D48") Is Nothing Then
        Application.EnableEvents = False

         End If           
        Set rngDate = Range("G2,G48")
        If Not Range("F2,F48") Is Nothing Then
        Application.EnableEvents = False

           End IF
         Set rngDate = Range("I2,I48")
           If Not Range("H2,H48") Is Nothing Then
         Application.EnableEvents = False

         End IF
      Set rngDate = Range("K2,K48")
      If Not Range("J2,J48") Is Nothing Then
      Application.EnableEvents = False

           End IF
      Set rngDate = Range("N2,N48")
      If Not Range("M2,M48") Is Nothing Then
      Application.EnableEvents = False

            End IF
     Set rngDate = Range("P2,P48")
     If Not Range("O2,O48") Is Nothing Then
     Application.EnableEvents = False

           End IF
     Set rngDate = Range("R2,R48")
     If Not Range("Q2,Q48") Is Nothing Then
     Application.EnableEvents = False

           End If
     Set rngDate = Range("T2,T48")
     If Not Range("S2,S48") Is Nothing Then
     Application.EnableEvents = False

    End If

End Sub

当前电子表格

img

我还试图为每个复选框设置总和,以便她查看底部销售的商品数量。

当我设置复选框时,它们都是Active X,我很确定我检查了真正的按钮,但我无法弄清楚现在在哪里可以找到这些信息。

感谢您的帮助。

0 个答案:

没有答案