Hàm tự động hiện ngày tháng của hành động nhập

[jano0112]

Chào cách anh chị,
Em đang có vấn đề như sau : Khi xây dựng quy trình thực hiện công việc , có các bước , nhân viên tích vào bước đã thực hiện. em muốn khi nhân viên tích vào đó sẽ hiển thị ngày tích ở ô bên cạnh. Có hàm nào thực hiện được không ạ ? Em cảm ơn cả nhà ^^

 

[HeSanbi]

Copy Code bên dưới vào một Public Module bất kì.
Sau đó chuột phải vào CheckBox chọn Gán Macro (Assign Macro)
Chọn hoặc dán CheckBoxCaller vào và chọn OK.

---------------------------

Public Sub CheckBoxCaller()
  On Error Resume Next
  SetDateByCheckBox Application.Caller(1)
End Sub

Private Sub SetDateByCheckBox(ByVal LabelName As String)
  Const PixelsPer# = 1.3333333333333
  On Error Resume Next
  Dim X As Single, Y As Single, Sp As Object, RNG As Range
  Set Sp = ActiveSheet.Shapes(LabelName)
  X = (Sp.Left + Sp.Width + 4) * PixelsPer + Application.ActiveWindow.Panes(1).PointsToScreenPixelsX(Application.ActiveWindow.Panes(1).VisibleRange.Left)
  Y = (Sp.Top) * PixelsPer + Application.ActiveWindow.Panes(1).PointsToScreenPixelsY(Application.ActiveWindow.Panes(1).VisibleRange.Top)
  Set RNG = Application.Windows(1).RangeFromPoint(X, Y)
  If ActiveSheet.CheckBoxes(LabelName).value = 1 Then
    RNG.value = VBA.Now()
  Else
    RNG.value = ""
  End If
  Set Sp = Nothing: Set RNG = Nothing
End Sub

 

[jano0112]

Copy Code bên dưới vào một Public Module bất kì.
Sau đó chuột phải vào CheckBox chọn Gán Macro (Assign Macro)
Chọn hoặc dán CheckBoxCaller vào và chọn OK.

---------------------------

Public Sub CheckBoxCaller()
  On Error Resume Next
  SetDateByCheckBox Application.Caller(1)
End Sub

Private Sub SetDateByCheckBox(ByVal LabelName As String)
  Dim X As Single, Y As Single, Sp As Object, RNG As Range
  Set Sp = ActiveSheet.Shapes(LabelName)
  X = Sp.Left: Y = Sp.Top
  Set RNG = Application.ActiveWindow.RangeFromPoint(X, Y)
  RNG(1, 2).value = VBA.Now()
  Set Sp = Nothing: Set RNG = Nothing
End Sub

Dạ, anh ơi nó báo như này ạ,

Bài đã được tự động gộp: 26/12/19

Copy Code bên dưới vào một Public Module bất kì.
Sau đó chuột phải vào CheckBox chọn Gán Macro (Assign Macro)
Chọn hoặc dán CheckBoxCaller vào và chọn OK.

---------------------------

Public Sub CheckBoxCaller()
  On Error Resume Next
  SetDateByCheckBox Application.Caller(1)
End Sub

Private Sub SetDateByCheckBox(ByVal LabelName As String)
  Dim X As Single, Y As Single, Sp As Object, RNG As Range
  Set Sp = ActiveSheet.Shapes(LabelName)
  X = Sp.Left: Y = Sp.Top
  Set RNG = Application.ActiveWindow.RangeFromPoint(X, Y)
  RNG(1, 2).value = VBA.Now()
  Set Sp = Nothing: Set RNG = Nothing
End Sub

lúc em click vào ạ

 

[HeSanbi]

Bạn copy lại Code và làm theo hướng dẫn.

Vì sao Ví dụ ở trên chỉ có 1 cột CheckBox, khi tôi xem lại Hình dưới này thì có đến 4 Cột Check Box, vậy thì làm sao Code đúng được.

Khó giúp!

Bài đã được tự động gộp: 26/12/19

Copy code dưới vào module
Sửa cột "G" trong CheckBoxCaller thành cột mong muốn
Chọn Sheet cần thực hiện và Click con trỏ chuột vào dòng code AssignMacroCheckBoxes và bấm F5

Public Sub CheckBoxCaller()
  On Error Resume Next
  SetDateByCheckBox Application.Caller(1), "G"
End Sub

Public Sub AssignMacroCheckBoxes()
  Dim CB As Shape
  For Each CB In ActiveSheet.Shapes
    If CB.Type = 8 Then
      CB.OnAction = "CheckBoxCaller"
    End If
  Next
End Sub


Private Sub SetDateByCheckBox(ByVal LabelName As String, Optional ByVal ColName$ = "G")
  On Error Resume Next
  Dim X As Single, Y As Single, Sp As Object, RNG As Range,Tmp
  Set Sp = ActiveSheet.Shapes(LabelName)
  X = 2 + Application.ActiveWindow.Panes(1).PointsToScreenPixelsX(Application.ActiveWindow.Panes(1).VisibleRange.Left)
  Y = Application.ActiveWindow.Panes(1).PointsToScreenPixelsY(Sp.Top + Application.ActiveWindow.Panes(1).VisibleRange.Top)
  Set RNG = Application.Windows(1).RangeFromPoint(X, Y)
  Set RNG = ActiveSheet.Range(ColName & RNG.Row)
  Tmp = RNG .Value
  If ActiveSheet.CheckBoxes(LabelName).value = 1 Then
    RNG.value = VBA.Now()
  Else
    RNG.value = Tmp
  End If
  Set Sp = Nothing: Set RNG = Nothing
End Sub

 

[batman1]

Copy code dưới vào module
Sửa cột "G" trong CheckBoxCaller thành cột mong muốn
Chọn Sheet cần thực hiện và Click con trỏ chuột vào dòng code AssignMacroCheckBoxes và bấm F5

1. Code chắc chắn chưa chuẩn. Xem hình dưới, chú ý là dòng nhìn thấy đầu tiên là dòng 3.



Xem tiếp hình 2


2. Không hiểu ý bạn lắm. Sao phải nhọc công thế khi mà Shape có thuộc tính TopLeftCell?