Macro ngăn không cho tạo sheet với tên đã có và báo bằng dòng thông báo "ABC..."

Liên hệ QC

ThuyNguyenHN

Thành viên hoạt động
Tham gia
24/6/09
Bài viết
159
Được thích
12
Chào các anh chị!

Mình có sưu tầm và làm 1 file excel nhập data và xuất file ra thành 1 sheet với tên sheet là giá trị của ô A3 trong sheet NHAP nhưng mình muồn khi nhỡ tay nhấn 2 lần vào nút TẠO SHEET thì sẽ hiện lên thông báo "Kiểm tra lại!" và ngăn không cho tạo sheet khi đó và chuyển con trỏ vào ô A3 của sheet NHAP

Mình xin gửi file đính kèm ở dưới!
 

File đính kèm

  • VD.xlsm
    939.6 KB · Đọc: 22
Chào các anh chị!

Mình có sưu tầm và làm 1 file excel nhập data và xuất file ra thành 1 sheet với tên sheet là giá trị của ô A3 trong sheet NHAP nhưng mình muồn khi nhỡ tay nhấn 2 lần vào nút TẠO SHEET thì sẽ hiện lên thông báo "Kiểm tra lại!" và ngăn không cho tạo sheet khi đó và chuyển con trỏ vào ô A3 của sheet NHAP

Mình xin gửi file đính kèm ở dưới!
b thay đổi code 1 chút là đc. Lưu ý phần bôi đỏ, nếu chạy code này thì shapes sẽ bị xóa nhé nên để shape ở ngoài mấy cột này
Mã:
Sub Oval3_Click()
Dim sh As Worksheet, trung As Boolean
    Sheets("NHAP").Select
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = Range("A3").Value Then trung = True
    Next
    If trung = False Then
        Sheets("NHAP").Copy After:=Sheets("NHAP")
        ActiveSheet.Name = Range("A3").Value
    Else
        MsgBox ("Da ton tai sheet with name: " & Range("A3").Value)
    End If
    ActiveSheet.Unprotect
[COLOR=#ff0000]    Columns("I:M").Select[/COLOR]
[COLOR=#ff0000]    Selection.Delete[/COLOR]
    ActiveSheet.Protect
     
    Sheets("NHAP").Select
    Range("A3").Select
    
End Sub
 
b thay đổi code 1 chút là đc. Lưu ý phần bôi đỏ, nếu chạy code này thì shapes sẽ bị xóa nhé nên để shape ở ngoài mấy cột này
Mã:
Sub Oval3_Click()
Dim sh As Worksheet, trung As Boolean
    Sheets("NHAP").Select
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = Range("A3").Value Then trung = True
    Next
    If trung = False Then
        Sheets("NHAP").Copy After:=Sheets("NHAP")
        ActiveSheet.Name = Range("A3").Value
    Else
        MsgBox ("Da ton tai sheet with name: " & Range("A3").Value)
    End If
    ActiveSheet.Unprotect
[COLOR=#ff0000]    Columns("I:M").Select[/COLOR]
[COLOR=#ff0000]    Selection.Delete[/COLOR]
    ActiveSheet.Protect
     
    Sheets("NHAP").Select
    Range("A3").Select
    
End Sub

Mình cảm ơn bạn quanluu1989!
Để mình thử chạy code luôn nhé! :)
 
b thay đổi code 1 chút là đc. Lưu ý phần bôi đỏ, nếu chạy code này thì shapes sẽ bị xóa nhé nên để shape ở ngoài mấy cột này
Mã:
Sub Oval3_Click()
Dim sh As Worksheet, trung As Boolean
    Sheets("NHAP").Select
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = Range("A3").Value Then trung = True
    Next
    If trung = False Then
        Sheets("NHAP").Copy After:=Sheets("NHAP")
        ActiveSheet.Name = Range("A3").Value
    Else
        MsgBox ("Da ton tai sheet with name: " & Range("A3").Value)
    End If
    ActiveSheet.Unprotect
[COLOR=#ff0000]    Columns("I:M").Select[/COLOR]
[COLOR=#ff0000]    Selection.Delete[/COLOR]
    ActiveSheet.Protect
     
    Sheets("NHAP").Select
    Range("A3").Select
    
End Sub

Code được rồi bạn ạ nhưng trường hợp có sheet trùng tên mà k muốn nó xóa đi cột I:K (Mục đích mình xóa đi cột I:K là để xóa đi 2 cái nút đó), 2 cái nút đó chỉ xóa khi không xuất hiện sheet trùng tên ạ!
 
Code được rồi bạn ạ nhưng trường hợp có sheet trùng tên mà k muốn nó xóa đi cột I:K (Mục đích mình xóa đi cột I:K là để xóa đi 2 cái nút đó), 2 cái nút đó chỉ xóa khi không xuất hiện sheet trùng tên ạ!

thế thì chỉ cần thay đổi vị trí code thui:
Mã:
Sub Oval3_Click()
Dim sh As Worksheet, trung As Boolean
    Application.ScreenUpdating = False
    
    Sheets("NHAP").Select
    ActiveSheet.Unprotect
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = Range("A3").Value Then trung = True
    Next
    If trung = False Then
        Sheets("NHAP").Copy After:=Sheets("NHAP")
        ActiveSheet.Name = Range("A3").Value
        Columns("I:M").Select
        Selection.Delete
    Else
        MsgBox ("Da ton tai sheet with name: " & Range("A3").Value)
    End If
    
    ActiveSheet.Protect
     
    Sheets("NHAP").Select
    Range("A3").Select
    Application.ScreenUpdating = True
End Sub
 
thế thì chỉ cần thay đổi vị trí code thui:
Mã:
Sub Oval3_Click()
Dim sh As Worksheet, trung As Boolean
    Application.ScreenUpdating = False
    
    Sheets("NHAP").Select
    ActiveSheet.Unprotect
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = Range("A3").Value Then trung = True
    Next
    If trung = False Then
        Sheets("NHAP").Copy After:=Sheets("NHAP")
        ActiveSheet.Name = Range("A3").Value
        Columns("I:M").Select
        Selection.Delete
    Else
        MsgBox ("Da ton tai sheet with name: " & Range("A3").Value)
    End If
    
    ActiveSheet.Protect
     
    Sheets("NHAP").Select
    Range("A3").Select
    Application.ScreenUpdating = True
End Sub

cảm ơn quanluu1989!
một đoạn Macro thực sự hữu ích với mình!
 
Web KT
Back
Top Bottom