Chỉ cho ghi lần đầu, không cho thay đổi hay xóa

[Number1gen]

Tôi có một vấn đề như sau, mong các bạn chỉ dẫn. Tôi muốn tạo ra một file nhập liệu, trong đó tất cả các cells dữ liệu chỉ được nhập một lần và giữ nguyên không cho xóa thay thay đổi. Mong các bạn giúp đỡ. Thanks

 

[nvson]

Nhấn Alt+F11 để vào VBA, nhấn đúp chuột vào ThisWorkbook, rồi thêm đoạn code sau:

Option Explicit
'
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Password toi dat la "nvson", ban co the thay doi lai
Dim rngData As Range
For Each rngData In Target.Cells
    If Not IsEmpty(rngData.Value) Then
        ActiveSheet.Protect ("nvson")
        Exit Sub
    Else
        ActiveSheet.Unprotect ("nvson")
    End If
Next rngData
End Sub

Bạn tham khảo thêm bài này nữa nhé!

 

[Number1gen]

Cám ơn bạn nhiều, vấn đề của mình là không phải bảo vệ công thức mà có một cell bất kỳ, sau khi nhập liệu (text) vào thì cell đó sẽ bị khóa, muốn xóa hay sửa phải có password. Mong bạn chỉ giúp.
Thanks

Nhấn Alt+F11 để vào VBA, nhấn đúp chuột vào ThisWorkbook, rồi thêm đoạn code sau:

Option Explicit
'
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Password toi dat la "nvson", ban co the thay doi lai
Dim rngData As Range
For Each rngData In Target.Cells
    If Not IsEmpty(rngData.Value) Then
        ActiveSheet.Protect ("nvson")
        Exit Sub
    Else
        ActiveSheet.Unprotect ("nvson")
    End If
Next rngData
End Sub

Bạn tham khảo thêm bài này nữa nhé!

 

[Number1gen]

Không có cao thủ nào giúp mình à. Buồn.

Cám ơn bạn nhiều, vấn đề của mình là không phải bảo vệ công thức mà có một cell bất kỳ, sau khi nhập liệu (text) vào thì cell đó sẽ bị khóa, muốn xóa hay sửa phải có password. Mong bạn chỉ giúp.
Thanks

 

[anhtuan1066]

Từ từ bạn ơi... đễ mọi người đi chơi cuối tuần đã chứ! Hi... hi...
ANH TUẤN

 

[tedaynui]

Cám ơn bạn nhiều, vấn đề của mình là không phải bảo vệ công thức mà có một cell bất kỳ, sau khi nhập liệu (text) vào thì cell đó sẽ bị khóa, muốn xóa hay sửa phải có password. Mong bạn chỉ giúp.
Thanks

Chào bạn
Mình nghĩ sẽ có nhiều cách thực hiện. Ở đây mình làm 1 ví dụ nhỏ, bạn thử kiểm tra xem có như mong muốn không nhé.

 

[Number1gen]

Cám ơn bạn nhiều, bạn có thể giúp mình một chương trình mà có thuộc tính như trên trong toàn bộ một sheet không? Ô nào trống thì muốn làm gì thì làm còn ô nào có dữ liệu thì không cho xóa hay sửa.
Thanks.

Chào bạn
Mình nghĩ sẽ có nhiều cách thực hiện. Ở đây mình làm 1 ví dụ nhỏ, bạn thử kiểm tra xem có như mong muốn không nhé.

 

[tedaynui]

Cám ơn bạn nhiều, bạn có thể giúp mình một chương trình mà có thuộc tính như trên trong toàn bộ một sheet không? Ô nào trống thì muốn làm gì thì làm còn ô nào có dữ liệu thì không cho xóa hay sửa.
Thanks.

Chào bạn
Nếu muốn toàn bộ các ô trên sheet đều có thuộc tính trên thì bạn vào VBA xoá dòng chữ màu đỏ (And Target.Address = "$A$1")

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Value <> "" [COLOR=Red][B]And Target.Address = "$A$1" [/B][/COLOR]Then PW.Show
End Sub

Mong bạn được như ý

TDN

 

[TranNguyenDanNhi]

Bác TDN khắc phục : Nếu chọn nhiều Cells, mặc dù các Cell đều rỗng, nhưng vẫn báo lỗi hoặc hiện User Form.

Cheer!

 

[Number1gen]

Đúng là có trường hợp như TNDN nêu, mong bạn khắc phục.

Bác TDN khắc phục : Nếu chọn nhiều Cells, mặc dù các Cell đều rỗng, nhưng vẫn báo lỗi hoặc hiện User Form.

Cheer!

 

[tedaynui]

Bác TDN khắc phục : Nếu chọn nhiều Cells, mặc dù các Cell đều rỗng, nhưng vẫn báo lỗi hoặc hiện User Form.

Cám ơn các bạn, lỗi này có thể khắc phục đựơc như sau :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Thoat:
If Target.Value <> "" Then PW.Show
Thoat:
End Sub

TDN

 

[TranNguyenDanNhi]

Khắc phục tiếp nhé :

Khi ta chọn nhiều Cells, nhưng Cells đầu tiên lại rỗng (thỏa mãn yêu cầu), sau đó copy đè lên vùng khác(có ô đầu tiên là rỗng) .

Chương trình vẫn chấp nhận ---> Dữ liệu sẽ bị xóa.

Có việc cho bác làm rồi đấy.

Cheer!

 

[tedaynui]

Gởi TranNguyenDanNhi
Thì bạn thêm dòng lệnh này vào

Application.CutCopyMode = False

TDN

 

[TranNguyenDanNhi]

Gởi TranNguyenDanNhi
Thì bạn thêm dòng lệnh này vào

Application.CutCopyMode = False

TDN

Đâu đơn giản như vậy, cái này chỉ ngăn được lệnh copy và cut thôi.
Còn nếu dùng mouse kéo qua thì vẫn OK mà.

Cheer!!

 

[tedaynui]

Đâu đơn giản như vậy, cái này chỉ ngăn được lệnh copy và cut thôi.
Còn nếu dùng mouse kéo qua thì vẫn OK mà.

Cám ơn bạn, thật sự mình cũng không rành, mình cũng đang học hỏi thôi. Vậy bạn thêm câu lệnh này xem có được không nhé

Application.CellDragAndDrop = False

TDN

 

[TranNguyenDanNhi]

OK, có vậy chứ.
Đừng bực mình nhé.

Cheer!

 

[tedaynui]

OK, có vậy chứ.
Đừng bực mình nhé.

Cheer!

Cảm ơn bạn đã dẫn dắt mình tìm hiểu cặn kẽ. Nếu vấn đề chưa được giải quyết thì có nhiều anh chị khác sẽ đưa ra lời giải đáp và đó chính là cơ hội cho mình học tập thêm mà
TDN

 

[Trần Văn Bình]

Anh sơn ơi phần code của anh la khóa cả sheet nhưng trong 1 vùng không đặt pass thì sao vậy

 

[nvson]

To Trần Văn Bình:
Mặc định tất cả các ô trong Sheet có thuộc tính Lock = True và chỉ có những ô có những ô có thuộc tính Lock = True thì khi bảo vệ bằng PassWord mới có hiệu lực.
Do đó nếu bạn muốn một vùng không đặt pass thì:
- Chọn vùng đó.
- Unprotect PW (nếu cần)
- Nhấn Format/ Cell, chọn tab Protection
- Bỏ tuỳ chọn Locked
- Nhấn OK để đóng hộp thoại.
Cuối cùng là Test thử....

 

[digita]

Chỉ cho gõ giá trị vào ô 1 lần & không cho thay đổi.

Dùng sự kiện sheet selection change (code dưới đây) sẽ giúp bạn làm việc này.

Cần đổi password trong code để tăng chức năng bảo mật.

Mến

[SIZE=3][FONT=Verdana][SIZE=2]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count = 1 Then
        If Target = "" Then
            Me.Unprotect ("password")
            Target.Locked = False
            Me.Protect ("password")
        Else
            Me.Unprotect ("password")
            Target.Locked = True
            Me.Protect ("password")
        End If
    Else
        MsgBox "Xin chon 1 o cho moi lan", vbInformation
        ActiveCell.Select
    End If
End Sub[/SIZE][/FONT][/SIZE]