V
vothanhthu
Guest
1. Giới thiệu
Như tất cả chúng ta đều biết, trong lập trình VBA chúng ta cần phải cân nhắc thật cẩn thận khi chạy một code liên quan đến gán giá trị vào sheet, vì khi chạy các giá trị được gán sheet vào sẽ không thể quay trở lại. Với lý do đó, hôm nay mình xin giới thiệu đến các bạn một kỹ thuật Undo lại các giá trị, tính chất của các đối tượng khi thay đổi bằng VBA
Kỹ thuật này mình trích dẫn nguồn từ bạn Jan Karel Pieterse thuộc JKP.
2. Code Undo trong Class Module
Tạo một Class Module tên clsExecAndUndo
Tạo Class Module nữa đặt tên clsUndoObject
3. Hướng dẫn sử dụng
Ví dụ: Mình có các dữ liệu như sau:
- Vùng A2:B6 có lần lượt các giá trị từ 1 đến 10;
- Ô D2 đang có màu xanh;
- Và mình có thêm một Shapes (Xanh viền cam) đặt tên là Shapes1.
Mình sẽ thêm đoạn code này vào để đổi vùng A2:B6 thành 10, D2 thành màu đỏ và màu Shapes1 thành màu đỏ luôn.
Trước tiên mình cần khai báo hàm ở đầu Module
Sau đó thực hiện các thay đổi trong Sub Change
Ở đây, đoạn code If ... End sẽ được bắt buộc thêm vào trước mỗi sub để gọi Class Module. Và khi gán thuộc tính, giá trị vào các đối tượng trên sheet chúng ta sẽ dùng lệnh sau đây, lệnh này sẽ lưu lại các tính chất, giá trị của đối tượng trước khi thay đổi bởi code
mUndoClass.AddAndProcessObject Đối_Tượng,"Tính chất",Giá trị
Trong đó:
Đối_Tượng: là các cell, shapes mà chúng ta muốn thay đổi giá trị, tính chất.
Tính chất: Là tính chất của Đối tượng, lưu ý để trong dấu ngoặc kép (""), Ví dụ: "Value","Height"...
Giá trị: Giá trị của các tính chất cần thay đổi.
Dễ hiểu hơn, Bình thường mình muốn thay đổi giá trị tại A2:B6 thì mình sẽ dùng lệnh
Giờ để Undo được ta sẽ dùng một lệnh đặc biệt như sau
Giờ mình tạo thêm một Sub để thực hiện chức năng Undo đặt tên luôn là Undo
Và đây là kết quả
4. Những điểm cần lưu ý
Khi thực hiện Undo bằng kỹ thuật này chúng ta chỉ có thể Undo được lần thay đổi code gần nhất của đối tượng đó, Ví dụ chúng ta nhấn 2 lần Sub Change thì không thể Undo được nữa.
Mỗi khi muốn Undo gì thì chúng ta phải có chủ ý ngay từ trước bằng cách thêm vào code, không thể cứ Ctrl + Z như bình thường.
Code sẽ rất hữu hiệu trong việc thực hiện những chương trình mà người sử dụng code cần Undo nhiều khi thao tác.
Trong nguồn tham khảo, tác giả ghi rất rõ ý tưởng code, các bạn xem tham khảo nha. Nguồn tham khảo:
Mình sẽ rất vui nếu như chia sẽ của mình đã mang lại cho bạn thêm một thông tin mới về VBA. Nếu có thắc mắc, khó khăn gì thì các bạn comment bên dưới phần trả lời, chúng ta cũng thảo luận nhé !
Như tất cả chúng ta đều biết, trong lập trình VBA chúng ta cần phải cân nhắc thật cẩn thận khi chạy một code liên quan đến gán giá trị vào sheet, vì khi chạy các giá trị được gán sheet vào sẽ không thể quay trở lại. Với lý do đó, hôm nay mình xin giới thiệu đến các bạn một kỹ thuật Undo lại các giá trị, tính chất của các đối tượng khi thay đổi bằng VBA
Kỹ thuật này mình trích dẫn nguồn từ bạn Jan Karel Pieterse thuộc JKP.
2. Code Undo trong Class Module
Tạo một Class Module tên clsExecAndUndo
Mã:
Option Explicit
Private mcolUndoObjects As Collection
Private mUndoObject As clsUndoObject
Public Function AddAndProcessObject(oObj As Object, sProperty As String, vValue As Variant) As Boolean
Set mUndoObject = New clsUndoObject
With mUndoObject
Set .ObjectToChange = oObj
.NewValue = vValue
.PropertyToChange = sProperty
mcolUndoObjects.Add mUndoObject
If .ExecuteCommand = True Then
AddAndProcessObject = True
Else
AddAndProcessObject = False
End If
End With
End Function
Private Sub Class_Initialize()
Set mcolUndoObjects = New Collection
End Sub
Private Sub Class_Terminate()
ResetUndo
End Sub
Public Sub ResetUndo()
While mcolUndoObjects.Count > 0
mcolUndoObjects.Remove (1)
Wend
Set mUndoObject = Nothing
End Sub
Public Sub UndoAll()
Dim lCount As Long
' On Error Resume Next
For lCount = mcolUndoObjects.Count To 1 Step -1
Set mUndoObject = mcolUndoObjects(lCount)
mUndoObject.UndoChange
Set mUndoObject = Nothing
Next
ResetUndo
End Sub
Public Sub UndoLast()
Dim lCount As Long
' On Error Resume Next
If mcolUndoObjects.Count >= 1 Then
Set mUndoObject = mcolUndoObjects(mcolUndoObjects.Count)
mUndoObject.UndoChange
mcolUndoObjects.Remove mcolUndoObjects.Count
Set mUndoObject = Nothing
Else
ResetUndo
End If
End Sub
Public Function UndoCount() As Long
UndoCount = mcolUndoObjects.Count
End Function
Mã:
Option Explicit
Private mUndoObject As Object
Private msProperty As String
Private mvNewValue As Variant
Private mvOldValue As Variant
Public Property Let PropertyToChange(sProperty As String)
msProperty = sProperty
End Property
Public Property Get PropertyToChange() As String
PropertyToChange = msProperty
End Property
Public Property Set ObjectToChange(oObj As Object)
Set mUndoObject = oObj
End Property
Public Property Get ObjectToChange() As Object
Set ObjectToChange = mUndoObject
End Property
Public Property Let NewValue(vValue As Variant)
mvNewValue = vValue
End Property
Public Property Get NewValue() As Variant
NewValue = mvNewValue
End Property
Public Property Let OldValue(vValue As Variant)
mvOldValue = vValue
End Property
Public Property Get OldValue() As Variant
OldValue = mvOldValue
End Property
Public Function ExecuteCommand() As Boolean
ExecuteCommand = False
If mUndoObject Is Nothing Then
End If
If mvNewValue = "" Then
End If
If msProperty = "" Then
End If
If GetOldValue Then
SetNewValue
ExecuteCommand = True
Else
'Failed to retrieve old value!
End If
End Function
Private Function GetOldValue() As Boolean
Dim oTemp As Object
Dim lCount As Long
Dim lProps As Long
Dim vProps As Variant
vProps = Split(PropertyToChange, ".")
lProps = UBound(vProps)
Set oTemp = ObjectToChange
For lCount = 0 To lProps - 1
Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
Next
If TypeOf oTemp Is Range Then
If LCase(vProps(lProps)) = "value" Then
vProps(lProps) = "Formula"
End If
End If
OldValue = CallByName(oTemp, vProps(lProps), VbGet)
If Err.Number = 0 Then
GetOldValue = True
Else
GetOldValue = False
End If
End Function
Private Function SetNewValue() As Boolean
Dim oTemp As Object
Dim lCount As Long
Dim lProps As Long
Dim vProps As Variant
Dim vResult As Variant
Err.Clear
Set oTemp = ObjectToChange
vProps = Split(PropertyToChange, ".")
lProps = UBound(vProps)
For lCount = 0 To lProps - 1
Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
Next
If TypeOf oTemp Is Range Then
If LCase(vProps(lProps)) = "value" Then
vProps(lProps) = "Formula"
End If
End If
vResult = CallByName(oTemp, vProps(lProps), VbLet, NewValue)
If Err.Number = 0 Then
SetNewValue = True
Else
SetNewValue = False
End If
End Function
Public Function UndoChange()
Dim oTemp As Object
Dim lCount As Long
Dim lProps As Long
Dim vProps As Variant
Dim vResult As Variant
Set oTemp = ObjectToChange
vProps = Split(PropertyToChange, ".")
lProps = UBound(vProps)
For lCount = 0 To lProps - 1
Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
Next
If TypeOf oTemp Is Range Then
If LCase(vProps(lProps)) = "value" Then
vProps(lProps) = "Formula"
End If
End If
vResult = CallByName(oTemp, vProps(lProps), VbLet, OldValue)
If vResult <> "" Then
UndoChange = True
Else
UndoChange = False
End If
End FunctionVí dụ: Mình có các dữ liệu như sau:
- Vùng A2:B6 có lần lượt các giá trị từ 1 đến 10;
- Ô D2 đang có màu xanh;
- Và mình có thêm một Shapes (Xanh viền cam) đặt tên là Shapes1.
Bạn cần đăng nhập để thấy đính kèm
Mình sẽ thêm đoạn code này vào để đổi vùng A2:B6 thành 10, D2 thành màu đỏ và màu Shapes1 thành màu đỏ luôn.
Trước tiên mình cần khai báo hàm ở đầu Module
Mã:
Option Explicit
Dim mUndoClass As clsExecAndUndo
Mã:
Sub Change()
If mUndoClass Is Nothing Then
Set mUndoClass = New clsExecAndUndo
Else
'Loai bo Undo truoc do
Set mUndoClass = Nothing
Set mUndoClass = New clsExecAndUndo
End If
mUndoClass.AddAndProcessObject ActiveSheet.Range("A2:B6"), "Value", 10 'Thay doi A2:B6 thanh 10
mUndoClass.AddAndProcessObject ActiveSheet.Range("D2"), "Interior.Colorindex", 3 'Doi mau D2 thanh mau Do
mUndoClass.AddAndProcessObject ActiveSheet.Shapes("Shapes1"), "Fill.ForeColor.SchemeColor", 10 'Doi mau Shape1 thanh mau do
End SubmUndoClass.AddAndProcessObject Đối_Tượng,"Tính chất",Giá trị
Trong đó:
Đối_Tượng: là các cell, shapes mà chúng ta muốn thay đổi giá trị, tính chất.
Tính chất: Là tính chất của Đối tượng, lưu ý để trong dấu ngoặc kép (""), Ví dụ: "Value","Height"...
Giá trị: Giá trị của các tính chất cần thay đổi.
Dễ hiểu hơn, Bình thường mình muốn thay đổi giá trị tại A2:B6 thì mình sẽ dùng lệnh
Mã:
Activesheet.Range("A2:B6").value = 10
Mã:
mUndoClass.AddAndProcessObject ActiveSheet.Range("A2:B6"), "Value", 10
Mã:
Sub Undo()
If mUndoClass Is Nothing Then Exit Sub
mUndoClass.UndoAll
Set mUndoClass = Nothing
End Sub
Bạn cần đăng nhập để thấy đính kèm
4. Những điểm cần lưu ý
Khi thực hiện Undo bằng kỹ thuật này chúng ta chỉ có thể Undo được lần thay đổi code gần nhất của đối tượng đó, Ví dụ chúng ta nhấn 2 lần Sub Change thì không thể Undo được nữa.
Mỗi khi muốn Undo gì thì chúng ta phải có chủ ý ngay từ trước bằng cách thêm vào code, không thể cứ Ctrl + Z như bình thường.
Code sẽ rất hữu hiệu trong việc thực hiện những chương trình mà người sử dụng code cần Undo nhiều khi thao tác.
Bạn cần đăng nhập để thấy link
Bạn cần đăng nhập để thấy link
Mình sẽ rất vui nếu như chia sẽ của mình đã mang lại cho bạn thêm một thông tin mới về VBA. Nếu có thắc mắc, khó khăn gì thì các bạn comment bên dưới phần trả lời, chúng ta cũng thảo luận nhé !
Sửa lần cuối bởi điều hành viên: