Hỏi về code xoá Users to edit ranges? (1 người xem)

[KUMI]

Xin chào Thầy Cô & Anh Chị trong GPE!
Tình hình là Em có một bài tán dưới đây, Thầy Cô và Anh Chị giúp Em với ạ! Xin cảm ơn!

Em có một file chứa rất nhiều "Users to edit ranges" ở nhiều Sheets.
Vậy Em phải viết code như thế nào để có thế xoá được hết toàn bộ "Users to edit ranges" trong toàn bộ Workbook này, sơ qua là file đính kèm ạ.

 

[nghiaphuc]

Xin chào Thầy Cô & Anh Chị trong GPE!
Tình hình là Em có một bài tán dưới đây, Thầy Cô và Anh Chị giúp Em với ạ! Xin cảm ơn!

Em có một file chứa rất nhiều "Users to edit ranges" ở nhiều Sheets.
Vậy Em phải viết code như thế nào để có thế xoá được hết toàn bộ "Users to edit ranges" trong toàn bộ Workbook này, sơ qua là file đính kèm ạ.

Bạn sử dụng code sau nhé:
[GPECODE=vb]Sub DeleteUserRanges()
With Sheet1.Protection.AllowEditRanges
Do While .Count > 0
.Item(.Count).Delete
Loop
End With
End Sub[/GPECODE]

 

[KUMI]

Bạn sử dụng code sau nhé:
[GPECODE=vb]Sub DeleteUserRanges()
With Sheet1.Protection.AllowEditRanges
Do While .Count > 0
.Item(.Count).Delete
Loop
End With
End Sub[/GPECODE]

Hi, Cảm ơn Anh Phúc nhiều ạ!
Ngoài cách dùng Do white..Loop thì còn cách nào khác nữa không anh.

Vì Em cũng đã sử dụng đoạn code này.

Sub DelRanges()

Dim N
For N = 1 To 3
Sheets(N).Activate
 Do While  ActiveSheet.Protection.AllowEditRanges.Count > 0
             [COLOR=#ff0000][B] ActiveSheet.Protection.AllowEditRanges(1).Delete[/B][/COLOR]
Loop
Next
End Sub

Nó thường hay bị lỗi cái đoạn màu đỏ

Nếu Em sử dụng On Error Resume Next thì file nó treo luôn vì cài Do While...Loop này.

 

[nghiaphuc]

Hi, Cảm ơn Anh Phúc nhiều ạ!
Ngoài cách dùng Do white..Loop thì còn cách nào khác nữa không anh.

Vì Em cũng đã sử dụng đoạn code này.

Sub DelRanges()

Dim N
For N = 1 To 3
Sheets(N).Activate
 Do While  ActiveSheet.Protection.AllowEditRanges.Count > 0
             [COLOR=#ff0000][B] ActiveSheet.Protection.AllowEditRanges(1).Delete[/B][/COLOR]
Loop
Next
End Sub

Nó thường hay bị lỗi cái đoạn màu đỏ

Nếu Em sử dụng On Error Resume Next thì file nó treo luôn vì cài Do While...Loop này.

Tôi chạy code trên lại không thấy vấn đề gì.
Nếu không thích Do While thì dùng For Next cũng được vậy. Bạn thử code sau xem:
[GPECODE=vb]Sub Test()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Sheets
Ws.Activate
For i = 1 To Ws.Protection.AllowEditRanges.Count
Ws.Protection.AllowEditRanges(1).Delete
Next
Next
End Sub[/GPECODE]
Ngoài ra, cũng nói thêm một vấn đề: Trong code trên, tôi thử bỏ câu lệnh Ws.Activate đi, kết quả là Excel báo lỗi và đóng chương trình lại. Như vậy có thể kết luận: Muốn can thiệp đến AllowEditRanges của một sheet thì phải Activate nó trước đã.

 

[TrungChinhs]

KUMI thử code này xem có được không ?

Sub DelRanges()
    On Error Resume Next
    For Each sh In Worksheets
        sh.Unprotect
        For i = sh.Protection.AllowEditRanges().Count To 1 Step -1
            sh.Protection.AllowEditRanges(i).Delete
        Next
    Next
End Sub

 

[KUMI]

Hi, Củ mì cảm ơn Bác TrungChinhs và Anh Nghĩa phúc nhé!

Kumi đã thử trên file kèm gửi lên thì không code nào bị lỗi cả.
Nhưng cứ cho vào file thật thì lại bị lỗi đoạn màu đỏ này:

Sub DelRanges()
    'On Error Resume Next
        ActiveWorkbook.Unprotect Password:=("123")
    Dim Sh
    For Each Sh In Worksheets
        Sh.Visible = 1
        Sh.Activate
        Sh.Unprotect Password:=("123")
        For i = Sh.Protection.AllowEditRanges().Count To 1 Step -1
            [COLOR=#ff0000][B]Sh.Protection.AllowEditRanges(i).Delete[/B][/COLOR]
        Next
        Sh.Protect Password:=("123")
    Next
        ActiveWorkbook.Protect Password:=("123"), Structure:=True, Windows:=False
End Sub

File nhân sự thông tin nội bộ nên Kumi không thể up lên được! Mong các Thầy và Anh Chị thông cảm ạ.

Nhưng các Thầy và Anh Chị thử phán đoán xem còn nguyên nhân nào nữa không ạ!Hix.
Em cũng sẽ vật lộn với cái dòng màu đỏ này xem do đâu ạ!
Cảm ơn mọi người đã giúp đỡ ạ!

 

[ndu96081631]

File nhân sự thông tin nội bộ nên Kumi không thể up lên được! Mong các Thầy và Anh Chị thông cảm ạ.

Nhưng các Thầy và Anh Chị thử phán đoán xem còn nguyên nhân nào nữa không ạ!Hix.
Em cũng sẽ vật lộn với cái dòng màu đỏ này xem do đâu ạ!
Cảm ơn mọi người đã giúp đỡ ạ!

Thì bạn cứ xóa hết dữ liệu đi rồi đưa file trống lên đây. Cái thằng AllowEditRanges nó sẽ vẫn còn nằm đó chứ có mất đi đâu

 

[KUMI]

Ý! Vậy con gửi file qua thư cho Thầy, Thầy xem rồi xử lý giúp con nhé!
Cảm ơn Thầy!

 

[TrungChinhs]

1- Tôi đoán lỗi có thể là do dấu nháy ở câu lệnh 'On Error Resume Next (bạn bỏ đi thử xem).
2- Không cần Sh.Activate (thừa)
3- Bạn gửi file 'thật" lên đi vì tôi cũng muốn xem tại sao code bị lỗi ?

 

[ndu96081631]

Ý! Vậy con gửi file qua thư cho Thầy, Thầy xem rồi xử lý giúp con nhé!
Cảm ơn Thầy!

Đã nhận file từ mail của bạn.
Đã xem và thử code, chạy bình thường hổng có lỗi nào cả

 

[KUMI]

Đã nhận file từ mail của bạn.
Đã xem và thử code, chạy bình thường hổng có lỗi nào cả

Hix!
Vậy Con mời Thầy và Bác ChungChinhs xem đoạn video này ạ!

1 điều lạ ở đây là code chạy độc lập thì không sao nhưng khi kết hợp cùng một số code khác thì có hiện tượng lỗi như vậy.