Попытка автоматического добавления дат в несколько столбцов после флажков автоматической проверки - PullRequest
Новая
       21

Попытка автоматического добавления дат в несколько столбцов после флажков автоматической проверки

0 голосов
/ 04 мая 2018

Я пытаюсь помочь моей матери с таблицей для ее инвентаря футболки, чтобы она могла иметь флажки и дату, которая заполняется после проверки стиля. После многочисленных часов видео и исследований на сайтах я попытался создать комбинацию из этих кодов, но безуспешно:

(с сайта: 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, и я почти уверен, что проверил кнопку true, но не могу понять, где найти информацию сейчас.

Спасибо за любую помощь.

...