Khóa lệnh move or copy & Save + thêm sheet (1 người xem)

  • Thread starter Thread starter Thien
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Thien

Thành viên thường trực
Tham gia
23/6/06
Bài viết
352
Được thích
113
Chào cả nhà!.

1/ Mình muốn tắt chức năng move or copy khi nhấp phải chuột tại tất cả các sheet trong WK?.

2/
Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lReply As Long
If SaveAsUI = True Then
lReply = MsgBox("Sorry, you are not allowed to save this workbook as another name. " _
& "Do you wish to save this workbook.", vbQuestion + vbOKCancel)
Cancel = (lReply = vbCancel)
If Cancel = False Then Me.Save
Cancel = True
End If
End Sub

Đoạn code trên cho phép không cho dùng save as. Mình cần chỉnh lại sao cho mỗi khi save as sẽ hỏi pass, nếu gỏ đúng pass thì cho save as, còn không đúng thì thực thi y chang code trên.

3/
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
MsgBox "Sorry, you cannot add any more sheets to this workbook", vbInformation
Sh.Delete
Application.DisplayAlerts = True
End Sub

đoạn code không cho thêm sheet, mình muốn khi thêm sheet sẽ hỏi pass, nếu gỏ đúng pass thì cho thêm, còn không đúng thì thực thi y chang code trên.

Hy vọng nhận được nhiều giúp đỡ.

Thân chào bạn
 
Cấm SAVE AS thì tôi ko bàn tới... nhưng với yêu cầu cấm MOVE OR COPY thì ko cần phải code làm gì cho mệt... Protect Workbook cũng dc rồi... Muốn mở chức năng phải biết Pass... Đạt yêu cầu rồi còn gì
ANH TUẤN
 
Upvote 0
Chào bạn
Bạn có thể dùng 2 câu lệnh này để không cho Cut hoặc Copy
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.CellDragAndDrop = False
Application.CutCopyMode = False
End Sub
TDN
 
Upvote 0
Thân chào anhtuan1066 & tedaynui.

Các bạn chưa giúp mình giải đáp triệt để khó khăn của mình rùi.
Ở đây mình đang nhờ các bạn thêm việc hỏi pass vào cocde của mình & đaọn code nào không cho dùng chức năng move or copy khi nhấp phải chuột.

Hy vọng nhận được nhiều sự giải đáp.

Thân chào
 
Upvote 0
Thien đã viết:
Thân chào anhtuan1066 & tedaynui.
Các bạn chưa giúp mình giải đáp triệt để khó khăn của mình rùi.
Ở đây mình đang nhờ các bạn thêm việc hỏi pass vào cocde của mình & đaọn code nào không cho dùng chức năng move or copy khi nhấp phải chuột.
Chào bạn
Nếu bạn muốn muỗi lần Save hay Inser new Sheet thì bạn thay MSGBOX thành INPUTBOX để nhập password vào. Nếu muốn Pro hơn thì tạo Form

Thân!
 
Upvote 0
tedaynui đã viết:
Chào bạn
Nếu bạn muốn muỗi lần Save hay Inser new Sheet thì bạn thay MSGBOX thành INPUTBOX để nhập password vào. Nếu muốn Pro hơn thì tạo Form

Thân!

Hì hì Sao không viết code giùm luôn đi.
Mình không rành đâu mà.

TC.
 
Upvote 0
Thien đã viết:
Hì hì Sao không viết code giùm luôn đi.
Mình không rành đâu mà.
TC.
Mình mượn code của bạn chỉ sửa lại đôi chút. Ở đây mình dùng Inputbox nên nhập PW sẽ thấy từng ký tự. Muốn Pro hơn, nhập PW chỉ hiện dấu sao "*" thì cần tạo Textbox trên Form
Đây là Code không cho save
Mã:
Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lReply As String
On Error GoTo Done
lReply = InputBox("Sorry, you are not allowed to save this workbook as another name. " _
& Chr(13) & "Do you wish to save this workbook.", "Input Password")
If lReply = "tedaynui" Then Exit Sub
Done:
Cancel = True
End Sub
TDN
 
Upvote 0
tedaynui đã viết:
Mình mượn code của bạn chỉ sửa lại đôi chút. Ở đây mình dùng Inputbox nên nhập PW sẽ thấy từng ký tự. Muốn Pro hơn, nhập PW chỉ hiện dấu sao "*" thì cần tạo Textbox trên Form
Đây là Code không cho save
Mã:
Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lReply As String
On Error GoTo Done
lReply = InputBox("Sorry, you are not allowed to save this workbook as another name. " _
& Chr(13) & "Do you wish to save this workbook.", "Input Password")
If lReply = "tedaynui" Then Exit Sub
Done:
Cancel = True
End Sub
TDN

Cảm ơn bạn quan tâm.
Còn khóa newsheet sao không giúp viết luôn nhỉ?.

TC.
 
Upvote 0
Thien đã viết:
Cảm ơn bạn quan tâm.
Còn khóa newsheet sao không giúp viết luôn nhỉ?.
TC.
Xin lỗi, mấy hôm nay nhiều việc quá chứ không phải thiếu nhiệt tình đâu. Vậy mình cũng lại tiếp tục mượn code của bạn sửa lại đôi chút nhé, bạn tham khảo xem
Mã:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim lReply As String
Application.DisplayAlerts = False
On Error GoTo Done
lReply = InputBox("Sorry, you cannot add any more sheets to this workbook", "Input Password")
If lReply = "tedaynui" Then
    Application.DisplayAlerts = True
    Exit Sub
End If
Done:
Sh.Delete
Application.DisplayAlerts = True
End Sub
TDN
 
Upvote 0
Cảm ơn sự nhiệt tình phổ biến kiến thức của bạn tedaynui.
Thật rất quý khi bạn đang bận mà vẫn dùng ít thời gian quý báo để chỉ giáo.
Nhưng còn vấn đề cuối cùng không kém phần quan trọng là tắt chức năng move or copy khi nhấp phải chuột tại tất cả các sheet trong WK vẫn chưa được bạn hướng dẫn.

Hy vọng nhận được nhiều hướng dẫn từ GPE.

TC.
 
Upvote 0
Thien đã viết:
Cảm ơn sự nhiệt tình phổ biến kiến thức của bạn tedaynui.
Thật rất quý khi bạn đang bận mà vẫn dùng ít thời gian quý báo để chỉ giáo.
Nhưng còn vấn đề cuối cùng không kém phần quan trọng là tắt chức năng move or copy khi nhấp phải chuột tại tất cả các sheet trong WK vẫn chưa được bạn hướng dẫn.
Hy vọng nhận được nhiều hướng dẫn từ GPE.
TC.
Bạn đọc kỹ lại bài số #3 cũng trong topic này
Thân
 
Upvote 0
tedaynui đã viết:
Chào bạn
Bạn có thể dùng 2 câu lệnh này để không cho Cut hoặc Copy
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.CellDragAndDrop = False
Application.CutCopyMode = False
End Sub
TDN

Cái này chỉ có tác dụng với Cells.
Khi ta muốn copy 1 sheet (Chuột trái + Ctrl hoặc chuột phải) thì sự kiện này không xi nhê gì.
Xin nhớ là copy sheet chứ không phải là copy (tất cả) cell trong sheet đó.
Làm sao đây nhỉ ??

Cheer!
 
Upvote 0
Tiện thể cho em hỏi luôn ở trên là chống copy và chống insert. Nếu chống xóa các Sheet nữa thì khai báo tiếp như thế nào
Nhờ các bác giúp cho
Thân
Bình
 
Upvote 0
uh không bạn ơi hiện nay mình chạy thử đoạn code trên chỉ chống được insert chứ không chống được move or copy... (nhấn phím phải chuột )
 
Upvote 0
TranNguyenDanNhi đã viết:
Cái này chỉ có tác dụng với Cells.
Khi ta muốn copy 1 sheet (Chuột trái + Ctrl hoặc chuột phải) thì sự kiện này không xi nhê gì.
Xin nhớ là copy sheet chứ không phải là copy (tất cả) cell trong sheet đó.
Làm sao đây nhỉ ??
Xin lỗi vì không hiểu rõ nên hiểu nhầm là Right click trên sheet. Thật sự, cái này mình cũng không biết giải quyết thế nào cho hiệu quả. Tạm thời bạn dùng thử cách sau để che Sheet tab
Mã:
Private Sub Workbook_Open()
    ActiveWindow.DisplayWorkbookTabs = False
End Sub
Thân!
TDN
 
Upvote 0
chào bạn
bạn có thể dùng 2 câu lệnh này để không cho cut hoặc copy
Mã:
private sub worksheet_selectionchange(byval target as range)
application.celldraganddrop = false
application.cutcopymode = false
end sub
tdn
chào anh.. Em đang sử dụng code nay của anh rất tốt anh có thể giúp em sủa lại chi áp dung cho sheet mà mình muốn áp dụng được không . Hiện tại đang áp dụng cho tất cả các sheet
xin cảm ơn.
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom