Không cho phép đổi tên Sheet (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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

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

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: 78
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

vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
13
Đọc
90
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
174
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu (1 người xem)
    • Buồn
2
Trả lời
26
Đọc
519
Phạm Trường 80
P
L
Lỗi font khi convert từ pdf
Trả lời
1
Đọc
49
Hoàng Tuấn 868
H
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
75
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
2
Đọc
74
DeTong
D
H
Đổi số thành chữ trong office 365
Trả lời
19
Đọc
1K
HoangTan891026
H
Gà Công Nghệ
Lấy dữ liệu file excel từ sheet này sang sheet khác
Trả lời
4
Đọc
127
Gà Công Nghệ
Gà Công Nghệ
N
Mong mọi người giúp đỡ
Trả lời
1
Đọc
59
minhminh27
minhminh27
minhduc1o2
Excel lỗi font Time New Roman+
Trả lời
7
Đọc
115
minhduc1o2
minhduc1o2
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
0
Đọc
72
fujishima
F
H
Lọc dữ liệu trong XL
    • Cười
Trả lời
0
Đọc
45
huong.dinh
H
giaiphap
Add-Ins hổ trợ Word trộn danh sách và lưu ra nhiều tệp tin khác nhau.
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
39
Đọc
9K
fujishima
F
K
xin file excel bảng đấu bóng đá (1 người xem)
    • Yêu thích
2 3
Trả lời
40
Đọc
25K
subin1905
S
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
24
Đọc
7K
chihuumvc
C
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
1
Đọc
64
bebo021999
B
G
Hướng dẫn Lập danh sách File (1 người xem)
    • Không thích
Trả lời
16
Đọc
267
thanhhuy_hvnh
thanhhuy_hvnh
baolong240793
Nhờ Anh/Chị hỗ trợ em hàm Randbetween() với ạ.
Trả lời
4
Đọc
360
bebo021999
B
Y
  • Question Question
Khóa VBA với mật khẩu mở
    • Thích
2 3 4
Trả lời
60
Đọc
5K
PhanTuHuong
PhanTuHuong
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom