Không cho phép đổi tên Sheet

Liên hệ QC
Nguoiay

Nguoiay

Thành viên hoạt động
Tham gia
24/11/10
Bài viết
139
Được thích
34
AC cho em hỏi có cách nào khoá tên Sheet không cho thay đổi tên? Giả sử em có Sheet tên DATA và em muốn không cho ai sửa tên nó. AC chỉ dùm em cách nào khoá hữu hiệu nhất!?
 
Nguoiay đã viết:
AC cho em hỏi có cách nào khoá tên Sheet không cho thay đổi tên? Giả sử em có Sheet tên DATA và em muốn không cho ai sửa tên nó. AC chỉ dùm em cách nào khoá hữu hiệu nhất!?
Nhấp chuột vào đây để mở rộng...

Trước khi chạy chú cho cái này

Sheet1.Name = "MENU"
Sheet2.Name = "CSDL"
Sheet3.Name = "MAIN"
Sheet4.Name = "DN"
Sheet5.Name = "TK"
Sheet6.Name = "SCAI"
Sheet7.Name = "NKC"
Sheet8.Name = "FOOTER"
Sheet9.Name = "SCT"
Sheet10.Name = "KH"
Sheet11.Name = "CDPS"
Sheet12.Name = "KQKD"
Sheet14.Name = "CDKT"

lên đầu thủ tục (theo file chú đã gửi anh)
đảm bảo không cần bẫy lỗi cái này nữa.

Mã: 
Option Explicit
Sub TenSheet()
    Sheet1.Name = "MENU"
    Sheet2.Name = "CSDL"
    Sheet3.Name = "MAIN"
    Sheet4.Name = "DN"
    Sheet5.Name = "TK"
    Sheet6.Name = "SCAI"
    Sheet7.Name = "NKC"
    Sheet8.Name = "FOOTER"
    Sheet9.Name = "SCT"
    Sheet10.Name = "KH"
    Sheet11.Name = "CDPS"
    Sheet12.Name = "KQKD"
    Sheet14.Name = "CDKT"
End Sub

Sub Taoso_cdps()
TenSheet
On Error Resume Next
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim rng As Range
Dim eRw1 As Long, eRw2 As Long
Set S1 = Sheets("TK")
Set S2 = Sheets("CDPS")
Application.ScreenUpdating = False
S2.Range("A9:H65535").Clear
eRw1 = S1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
S1.Range("A6:D" & eRw1).Copy Destination:=S2.Range("A9")
eRw2 = S2.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Range("E9").Formula = "=SUMIF(CSDL!$F$2:$F$65535,CDPS!A9&""*"",CSDL!$H$2:$H$65535)"
    Range("F9").Formula = "=SUMIF(CSDL!$G$2:$G$65535,CDPS!A9&""*"",CSDL!$I$2:$I$65535)"
    Range("G9").Formula = "=MAX(C9+E9-D9-F9,0)"
    Range("H9").Formula = "=MAX(D9+F9-C9-E9,0)"
    'Range("I9").Formula = "=IF(SUM(C9:H9)<>0,1,0)"
    Set rng = S2.Range("E9:H" & eRw2)
    Range("E9:H9").Copy rng
    rng.Value = rng.Value
    rng.NumberFormat = "_(* #,##0_);_(* (#,##0);"""""
    With S2.Range("A9").Resize(eRw2 - 8, 8)
        .BorderAround LineStyle:=1
        .Borders(11).LineStyle = 1: .Borders(11).ColorIndex = 1
        .Borders(12).LineStyle = 1: .Borders(12).ColorIndex = 1
    End With
    Sheets("Footer").Range("A21:H25").Copy S2.Range("A9").Offset(eRw2 - 8)
    With S2.Cells(eRw2 + 1, "C").Resize(, 6)
            .FormulaR1C1 = "=SUBTOTAL(9,R9C:R[-1]C)"
            .Font.Name = "Arial"
            .Font.Size = 11
    End With
    S2.Cells(eRw2 + 1, "C").Resize(, 6).Value = S2.Cells(eRw2 + 1, "C").Resize(, 6).Value
    Set rng = Nothing
    Set S2 = Nothing
    Set S1 = Nothing
End Sub

Code trong file của chú đấy
 
vuminh1601 đã viết:
Trước khi chạy chú cho cái này

Sheet1.Name = "MENU"
Sheet2.Name = "CSDL"
Sheet3.Name = "MAIN"
Sheet4.Name = "DN"
Sheet5.Name = "TK"
Sheet6.Name = "SCAI"
Sheet7.Name = "NKC"
Sheet8.Name = "FOOTER"
Sheet9.Name = "SCT"
Sheet10.Name = "KH"
Sheet11.Name = "CDPS"
Sheet12.Name = "KQKD"
Sheet14.Name = "CDKT"

lên đầu thủ tục (theo file chú đã gửi anh)
đảm bảo không cần bẫy lỗi cái này nữa.

Mã: 
Option Explicit
Sub TenSheet()
Sheet1.Name = "MENU"
Sheet2.Name = "CSDL"
Sheet3.Name = "MAIN"
Sheet4.Name = "DN"
Sheet5.Name = "TK"
Sheet6.Name = "SCAI"
Sheet7.Name = "NKC"
Sheet8.Name = "FOOTER"
Sheet9.Name = "SCT"
Sheet10.Name = "KH"
Sheet11.Name = "CDPS"
Sheet12.Name = "KQKD"
Sheet14.Name = "CDKT"
End Sub
 
Sub Taoso_cdps()
TenSheet
On Error Resume Next
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim rng As Range
Dim eRw1 As Long, eRw2 As Long
Set S1 = Sheets("TK")
Set S2 = Sheets("CDPS")
Application.ScreenUpdating = False
S2.Range("A9:H65535").Clear
eRw1 = S1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
S1.Range("A6:D" & eRw1).Copy Destination:=S2.Range("A9")
eRw2 = S2.Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("E9").Formula = "=SUMIF(CSDL!$F$2:$F$65535,CDPS!A9&""*"",CSDL!$H$2:$H$65535)"
Range("F9").Formula = "=SUMIF(CSDL!$G$2:$G$65535,CDPS!A9&""*"",CSDL!$I$2:$I$65535)"
Range("G9").Formula = "=MAX(C9+E9-D9-F9,0)"
Range("H9").Formula = "=MAX(D9+F9-C9-E9,0)"
'Range("I9").Formula = "=IF(SUM(C9:H9)<>0,1,0)"
Set rng = S2.Range("E9:H" & eRw2)
Range("E9:H9").Copy rng
rng.Value = rng.Value
rng.NumberFormat = "_(* #,##0_);_(* (#,##0);"""""
With S2.Range("A9").Resize(eRw2 - 8, 8)
.BorderAround LineStyle:=1
.Borders(11).LineStyle = 1: .Borders(11).ColorIndex = 1
.Borders(12).LineStyle = 1: .Borders(12).ColorIndex = 1
End With
Sheets("Footer").Range("A21:H25").Copy S2.Range("A9").Offset(eRw2 - 8)
With S2.Cells(eRw2 + 1, "C").Resize(, 6)
.FormulaR1C1 = "=SUBTOTAL(9,R9C:R[-1]C)"
.Font.Name = "Arial"
.Font.Size = 11
End With
S2.Cells(eRw2 + 1, "C").Resize(, 6).Value = S2.Cells(eRw2 + 1, "C").Resize(, 6).Value
Set rng = Nothing
Set S2 = Nothing
Set S1 = Nothing
End Sub

Code trong file của chú đấy
Nhấp chuột vào đây để mở rộng...

Ui, anh quen em uh? Code này có phải của em đâu? Anh có nhầm không? Mà Sub Tensheet bạn cũng không đúng ý mình rùi...
 
Lần chỉnh sửa cuối:
Nguoiay đã viết:
AC cho em hỏi có cách nào khoá tên Sheet không cho thay đổi tên? Giả sử em có Sheet tên DATA và em muốn không cho ai sửa tên nó. AC chỉ dùm em cách nào khoá hữu hiệu nhất!?
Nhấp chuột vào đây để mở rộng...
Bạn chọn Tools\Protect\Protect Workbook => Nhập 2 lần Password => OK.
Còn nếu muốn dùng code thì bạn nháy chuột phải tại tên sheet DATA, chọn View code và dán code sau vào:
PHP: 
Private Sub Worksheet_Deactivate()
    Me.Name = "DATA"
End Sub
 
nghiaphuc đã viết:
Bạn chọn Tools\Protect\Protect Workbook => Nhập 2 lần Password => OK.
Còn nếu muốn dùng code thì bạn nháy chuột phải tại tên sheet DATA, chọn View code và dán code sau vào:
PHP: 
Private Sub Worksheet_Deactivate()
Me.Name = "DATA"
End Sub
Nhấp chuột vào đây để mở rộng...

Cách thứ nhất của anh thì được. Nhưng còn Code thì em test vẫn chưa được. Em sửa code đó thành:
PHP: 
Private Sub Worksheet_Activate()
    Me.Name = "DATA"
End Sub
thì khi Sheet đó được kích hoạt nó lại trả lại tên cũ. Cho em hỏi còn cách viết code nào khác để khoá nữa không ah?
 
Nguoiay đã viết:
Cách thứ nhất của anh thì được. Nhưng còn Code thì em test vẫn chưa được. Em sửa code đó thành:
PHP: 
Private Sub Worksheet_Activate()
    Me.Name = "DATA"
End Sub
thì khi Sheet đó được kích hoạt nó lại trả lại tên cũ. Cho em hỏi còn cách viết code nào khác để khoá nữa không ah?
Nhấp chuột vào đây để mở rộng...
Bạn đơn thuần dùng Sự kiện này là không ổn rồi. Tôi giả định như sau: Tôi đang ở Sheet "DATA" tôi sửa thành "DATAY" tôi sang Sheet "SoCai" tôi chạy thì lỗi là cái chắc.
Nếu mục đích của bạn là ẩn, hoặc ko cho thay đổi tên Sheet thì bạn

Cách1: Bẫy cái lỗi Gặp lỗi thì cho nó chạy Sub doiten() #2 và chạy tiếp các ứng dụng của bạn.
Cách2: Ẩn Option như bác ndu đã hướng dẫn
Cách3: Bạn sửa luôn tên Sheet trong mục properties. Cách này sẽ là đơn giản và tối ưu nhất.
 
Nguoiay đã viết:
AC cho em hỏi có cách nào khoá tên Sheet không cho thay đổi tên? Giả sử em có Sheet tên DATA và em muốn không cho ai sửa tên nó. AC chỉ dùm em cách nào khoá hữu hiệu nhất!?
Nhấp chuột vào đây để mở rộng...

Cái này hơi khó vì khi em đổi tên không xảu ra sự kiện nào để mình kiểm soát được. Cách đơn giản là gắn tên đó vào 1 ô nào đó và sử dụng lập trình sự kiện để luôn cập nhật tên.
 
PhanTuHuong đã viết:
Cái này hơi khó vì khi em đổi tên không xảu ra sự kiện nào để mình kiểm soát được. Cách đơn giản là gắn tên đó vào 1 ô nào đó và sử dụng lập trình sự kiện để luôn cập nhật tên.
Nhấp chuột vào đây để mở rộng...
Ngồi buồn.. thất nghiệp... làm thử sự kiện này xem chơi nha!
Đâu mọi người thử mở file đính kèm và đổi tên sheet xem có được không nha! ---> Đương nhiên khi mở file phải Enable Macros mới tác dụng
Ẹc... Ec.... Cũng thú vị đây
 

File đính kèm

  • ShNameProtect.xls
    18 KB · Đọc: 173
ndu96081631 đã viết:
Ngồi buồn.. thất nghiệp... làm thử sự kiện này xem chơi nha!
Đâu mọi người thử mở file đính kèm và đổi tên sheet xem có được không nha! ---> Đương nhiên khi mở file phải Enable Macros mới tác dụng
Ẹc... Ec.... Cũng thú vị đây
Nhấp chuột vào đây để mở rộng...

Sao em cứ mở file của bác là Excel báo lỗi và tưh thoát. E dùng OFfice2007. Bác gửi cho E xem cái code với.
 
vuminh1601 đã viết:
Sao em cứ mở file của bác là Excel báo lỗi và tưh thoát. E dùng OFfice2007. Bác gửi cho E xem cái code với.
Nhấp chuột vào đây để mở rộng...
Tôi đang mở file trên Excel 2007 đây, có lỗi gì đâu!
Code thì chỉ có vầy:
PHP: 
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private ShArr As Object
PHP: 
Sub TimerProc()
  Dim Sh As Worksheet
  On Error Resume Next
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> ShArr.Item(Sh.CodeName) Then Sh.Name = ShArr.Item(Sh.CodeName)
  Next
End Sub
PHP: 
Sub Auto_Open()
  Dim Sh As Worksheet
  KillTimer Application.hwnd, 1
  Set ShArr = CreateObject("Scripting.Dictionary")
  For Each Sh In ThisWorkbook.Worksheets
    ShArr.Add Sh.CodeName, Sh.Name
  Next
  SetTimer Application.hwnd, 1, 200, AddressOf TimerProc
End Sub
PHP: 
Sub Auto_Close()
  KillTimer Application.hwnd, 1
End Sub
 
Ngồi buồn.. .. làm thử sự kiện này xem chơi nha!
Đâu mọi người thử mở file đính kèm và đổi tên sheet xem có được không nha! Ẹc... Ec.... Cũng thú vị đây
Nhấp chuột vào đây để mở rộng...

Cũng nhàn cư vi bất thiện: Không đi đường thẳng, ta đi đường ngoằng nghềo vậy: Thực hiện nhân bản vô tính ; sau đó xóa các anh cũ đi & đổi tên các trang đã được nhân bản này; Khà, khà,. . . .
 
ChanhTQ@ đã viết:
Cũng nhàn cư vi bất thiện: Không đi đường thẳng, ta đi đường ngoằng nghềo vậy: Thực hiện nhân bản vô tính ; sau đó xóa các anh cũ đi & đổi tên các trang đã được nhân bản này; Khà, khà,. . . .
Nhấp chuột vào đây để mở rộng...
Có nhiều cách để cải tiến. chẳng hạn:
- Viết thêm 1 code nữa ---> Với sự kiện Workbook_NewSheet, nếu có sheet mới là xóa luôn
- Khóa menu Insert\Worksheet và popup menu Move or Copy to
vân vân... nhiều cách lắm. Nhưng để "phá" thì lại càng nhiều cách hơn, chẳng hạn thay vì làm như sư phụ, em chỉ cần.. Disable Macros là xong!
Ẹc... Ẹc...
Thật ra với hàm SetTimer, em muốn nói rằng: Chúng ta có thể viết bất cứ sự kiện gì mà ta thích, kể cả những sự kiện chưa từng có trong Excel
Ứng dụng của SetTimer vô cùng lắm, trong topic này chỉ là "buồn tay viết chơi" thôi sư phụ à
 
ndu96081631 đã viết:
Tôi đang mở file trên Excel 2007 đây, có lỗi gì đâu!
Code thì chỉ có vầy:
PHP: 
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private ShArr As Object
PHP: 
Sub TimerProc()
  Dim Sh As Worksheet
  On Error Resume Next
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> ShArr.Item(Sh.CodeName) Then Sh.Name = ShArr.Item(Sh.CodeName)
  Next
End Sub
PHP: 
Sub Auto_Open()
  Dim Sh As Worksheet
  KillTimer Application.hwnd, 1
  Set ShArr = CreateObject("Scripting.Dictionary")
  For Each Sh In ThisWorkbook.Worksheets
    ShArr.Add Sh.CodeName, Sh.Name
  Next
  SetTimer Application.hwnd, 1, 200, AddressOf TimerProc
End Sub
PHP: 
Sub Auto_Close()
  KillTimer Application.hwnd, 1
End Sub
Nhấp chuột vào đây để mở rộng...

Bác ndu ơi khi em thêm Sheet mới vào thì không được. Với lại E thấy dùng code này có vẻ dễ bị lỗi hay sao ấy?
 

File đính kèm

  • ShNameProtect2.xls
    43 KB · Đọc: 38
vuminh1601 đã viết:
Bác ndu ơi khi em thêm Sheet mới vào thì không được
Nhấp chuột vào đây để mở rộng...
Tôi thêm sheet vào bình thường thôi, có gì không được đâu
vuminh1601 đã viết:
Với lại E thấy dùng code này có vẻ dễ bị lỗi hay sao ấy?
Nhấp chuột vào đây để mở rộng...
Tôi test mấy chục lần, chẳng thấy lỗi gì, cả trên Excel 2003 và Excel 2007 ---> Tôi nghĩ Office của bạn chắc có vấn đề rồi
 
Em chạy code thấy sau khi đổi tên Sheet thì thoát khỏi file, sau đó vào lại thì code mới có tác dụng. Nhưng khi mở VBE ra thì menu bị chuyển màu. như hình kèm theo. trước đó E mở ra không sao. Cái khung Propeties thì bị mờ đi.
 

File đính kèm

  • menu bi chuyen mau.JPG
    menu bi chuyen mau.JPG
    99.8 KB · Đọc: 77
Lần chỉnh sửa cuối:
vuminh1601 đã viết:
Em chạy code thấy sau khi đổi tên Sheet thì thoát khỏi file, sau đó vào lại thì code mới có tác dụng. Nhưng khi mở VBE ra thì menu bị chuyển màu. như hình kèm theo. trước đó E mở ra không sao. Cái khung Propeties thì bị mờ đi.
Nhấp chuột vào đây để mở rộng...
Trời! Bạn đọc code của tôi xem có chổ nào liên quan đến MENU không? Code cực đơn giản mà bạn ---> Nói chung là hổng có liên quan gì đến tất cả những lỗi mà bạn đã nêu cả! Xem hình ảnh trên máy tôi đây! Chẳng có menu nào bị mờ hay đổi màu gì cả

untitled.JPG


Xem lại Office của bạn hoặc đơn giản là mang file sang máy tính khác để thí nghiệm rồi tìm hiểu nguyên nhân nhé
Ngoài ra, để thí nghiệm chính xác, tốt nhất bạn nên đóng toàn bộ các file đang mở, chỉ chạy 1 file duy nhất mà ta thí nghiệm thôi
 
Lần chỉnh sửa cuối:
Em làm theo anh ndu chạy bình thường ở cả 2 office 2003 và 2007.
 
Nguoiay đã viết:
Em làm theo anh ndu chạy bình thường ở cả 2 office 2003 và 2007.
Nhấp chuột vào đây để mở rộng...
Cần lưu ý rằng: Code này tuy không cho đổi tên sheet nhưng vẫn cho thêm sheet nhé ---> Và với sheet mới thì ta đặt tên thoải mái ---> Chỉ sau khi đóng và lưu file xong, mở lại thì những sheet mới đã thêm lần trước lại bị code khống chế, không cho đổi tên nữa
 
ndu96081631 đã viết:
Ngồi buồn.. thất nghiệp... làm thử sự kiện này xem chơi nha!
Đâu mọi người thử mở file đính kèm và đổi tên sheet xem có được không nha! ---> Đương nhiên khi mở file phải Enable Macros mới tác dụng
Ẹc... Ec.... Cũng thú vị đây
Nhấp chuột vào đây để mở rộng...
mình thấy đổi bình thương tên sheet được nè bạn
 
ndu96081631 đã viết:
Ngồi buồn.. thất nghiệp... làm thử sự kiện này xem chơi nha!
Đâu mọi người thử mở file đính kèm và đổi tên sheet xem có được không nha! ---> Đương nhiên khi mở file phải Enable Macros mới tác dụng
Ẹc... Ec.... Cũng thú vị đây
Nhấp chuột vào đây để mở rộng...
anh ơi a có bản cho 64bit không ạ? máy e dùng 64bit nên không bị lỗi ạ. cảm ơn anh
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
11
Đọc
176
emlat3
emlat3
P
TÔ MÀU THEO ĐIỀU KIỆN HÀNG GHI NGÀY ĐẦU TIÊN
Trả lời
0
Đọc
1
phantuancauvan
P
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
0
Đọc
1
Emyeuexcel
Emyeuexcel
kyo
  • Suggestion
Bài viết: SAP Scripting – Excel và SAP (P2)
    • Thích
Trả lời
13
Đọc
8K
Tình nghĩa giang hồ
Tình nghĩa giang hồ
A
Tính tổng dữ liệu băng dictionary
Trả lời
6
Đọc
91
DeTong
D
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom