Ngăn mở thêm sheet mới

[kangta_lee]

File excel của mình đang được sử dụng dung với nhiều phòng ban, khổ cái là tụi nó cứ thêm nhiều sheet mới lung tung vào.
Vì đây là file mở, mọi người sẽ nhập thêm dữ liệu vào nên không clock nó được. Mình có tham khảo trên mạng thì hiện trên mạng đang có 1 đoạn code

"Private Sub Workbook_NewSheet (ByVal Sh As Object)
Application.DisplayAlert = False
MsgBox "Sorry, you can't add any more sheet to this workbook", _
vbInformation
Sh.Delete
Application.DisplayAlert = True
End Sub"

Mình đã thử nhưng không được. Mong các cao nhân chỉ giúp mình giải pháp.
Thanks.

 

[Nhattanktnn]

File excel của mình đang được sử dụng dung với nhiều phòng ban, khổ cái là tụi nó cứ thêm nhiều sheet mới lung tung vào.
Vì đây là file mở, mọi người sẽ nhập thêm dữ liệu vào nên không clock nó được. Mình có tham khảo trên mạng thì hiện trên mạng đang có 1 đoạn code

"Private Sub Workbook_NewSheet (ByVal Sh As Object)
Application.DisplayAlert = False
MsgBox "Sorry, you can't add any more sheet to this workbook", _
vbInformation
Sh.Delete
Application.DisplayAlert = True
End Sub"

Mình đã thử nhưng không được. Mong các cao nhân chỉ giúp mình giải pháp.
Thanks.

Khóa workbook cũng được mà bạn, tương tác với sheet như xóa, thêm, ẩn, hiện sheet không thực hiện được. Nhưng nhập liệu vào các sheet vẫn không vấn đề

 

[kangta_lee]

Khóa workbook cũng được mà bạn, tương tác với sheet như xóa, thêm, ẩn, hiện sheet không thực hiện được. Nhưng nhập liệu vào các sheet vẫn không vấn đề

thanks bạn nhé. mình đã thử và thấy ok.

 

[giaiphap]

File excel của mình đang được sử dụng dung với nhiều phòng ban, khổ cái là tụi nó cứ thêm nhiều sheet mới lung tung vào.
Vì đây là file mở, mọi người sẽ nhập thêm dữ liệu vào nên không clock nó được. Mình có tham khảo trên mạng thì hiện trên mạng đang có 1 đoạn code

"Private Sub Workbook_NewSheet (ByVal Sh As Object)
Application.DisplayAlert = False
MsgBox "Sorry, you can't add any more sheet to this workbook", _
vbInformation
Sh.Delete
Application.DisplayAlert = True
End Sub"

Mình đã thử nhưng không được. Mong các cao nhân chỉ giúp mình giải pháp.
Thanks.

Thêm dòng bắt lỗi thử xem.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    On Error Resume Next
    Application.DisplayAlert = False
    MsgBox "Sorry, you can't add any more sheet to this workbook", vbInformation
    Sh.Delete
    Application.DisplayAlert = True
End Sub

 

[ptm0412]

Về lý thuyết thì code không lỗi, có lẽ vấn đề là code đặt ở đâu.

Mình đã thử nhưng không được.

Không được! là không được như thế nào? Trình tự làm như thế nào? Có thông báo lỗi không? Thông báo lỗi là gì?

 

[VetMini]

...
Không được! là không được như thế nào? Trình tự làm như thế nào? Có thông báo lỗi không? Thông báo lỗi là gì?

Cao nhơn no understand. Nếu biết ntn thì đã làm ntn.
Get real!

 

[bebo021999]

Giả sử file hoàn chỉnh của bạn có 3 sheets và không muốn thêm bớt.
Khi bạn dupplicate sheet, hoặc tạo sheet mới, hoặc import sheet từ file khác vô, sheet mới này sẽ tự động activate nên:
Dùng tạm cái này, dù chưa phải là tối ưu:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sheets.Count > 3 Then ' Giả sử bạn khống chế số sheet tối đa là 3. Điều chỉnh số thích hợp.
    MsgBox "Sorry, you can't add any more sheet to this workbook"
    Sh.Delete
End If
End Sub

Chưa tối ưu là vì nếu user chọn nhiều sheet rồi duplicate (copy) code trên không giải quyết được.
Trường hợp này bạn cần lưu danh sách tên sheet chuẩn vào 1 biến. Sau đó so danh sách sheets hiện tại với DS chuẩn, cái nào không có thì delete.
(Mình chưa có thời gian làm cái này, hy vọng ai đó sẽ động lòng nhảy vô làm giúp)

 

[ptm0412]

Code bài 1 chạy "không được" ngay từ dòng đầu do sai chính tả
Code bài 4 để nguyên lỗi chính tả mà bắt resume next nên cũng như không

(Mình chưa có thời gian làm cái này, hy vọng ai đó sẽ động lòng nhảy vô làm giúp)

Này thì động lòng, nhưng không phải động lòng vì tác giả bài 1, mà là động lòng vì bé bo

Code trong module:

Sub DelExtraSheet()
Dim ShArr, ShExist As Boolean, ShCount As Long, ShCount2 As Long
ShArr = Array(Sheet3.Name, Sheet4.Name, Sheet5.Name)
ShCount = UBound(ShArr) + 1
ShCount2 = Sheets.Count
If ShCount = ShCount2 Then Exit Sub
Application.DisplayAlerts = False
For i = 1 To Sheets.Count
    ShExist = False
    For j = 1 To ShCount
        If Sheets(i).Name = ShArr(j - 1) Then ShExist = True
    Next
    On Error GoTo Again
    If ShExist = False Then Sheets(i).Delete
    ShCount2 = Sheets.Count
    If ShCount2 = ShCount Then Exit For
Next
Application.DisplayAlerts = True
Exit Sub
Again:
DelExtraSheet
End Sub

Code trong workbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
DelExtraSheet
End Sub

Sở dĩ ShArr lấy Sheet3.Name thay vì lấy "Sheet3" hay "TongHop" vì cần phòng xa người dùng sửa tên sheet trước khi insert
Sở dĩ phải chạy 2 lần là vì lỗi mà không muốn bắt lỗi

 

[mbckorean]

Cao nhơn no understand. Nếu biết ntn thì đã làm ntn.
Get real!

Kinh nghiệm của tôi là không nên làm việc với những người viết tắt
( Trích bình luận dạo của anh Vetmini)
Bạn tưởng vậy là ngầu à