Copy sheet nhưng không copy code (1 người xem)

[giaiphap]

Tôi có vấn đề về copy sheet nhờ anh em trong diễn đàn chỉ giúp như sau: File Excel của tôi có một sheet trong sheet đó có chứa đoạn code như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [C2]) Is Nothing Then
    MsgBox "Ban vua thay doi gia tri o C2"
 End If
End Sub

Sau đó tôi sử dụng code sau để tách sheet đó ra thành file mới.

Sub GPE()
    Sheet1.Copy
End Sub

Vấn đề tôi chưa làm được là khi copy ra file mới thì đoạn code trong sheet vẫn còn, vậy có cách nào chỉ copy sheet thôi, còn đoạn code trong file không cần copy, anh em trong diễn đàn ai biết chỉ giáo với cảm ơn trước vậy!

 

[phuyen89]

Tôi có vấn đề về copy sheet nhờ anh em trong diễn đàn chỉ giúp như sau: File Excel của tôi có một sheet trong sheet đó có chứa đoạn code như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [C2]) Is Nothing Then
    MsgBox "Ban vua thay doi gia tri o C2"
 End If
End Sub

Sau đó tôi sử dụng code sau để tách sheet đó ra thành file mới.

Sub GPE()
    Sheet1.Copy
End Sub

Vấn đề tôi chưa làm được là khi copy ra file mới thì đoạn code trong sheet vẫn còn, vậy có cách nào chỉ copy sheet thôi, còn đoạn code trong file không cần copy, anh em trong diễn đàn ai biết chỉ giáo với cảm ơn trước vậy!

Nếu truy cập vào VBProject.VBComponents để xóa Code trong Module thì Anh thấy sao.

 

[giaiphap]

Nếu truy cập vào VBProject.VBComponents để xóa Code trong Module thì Anh thấy sao.

Cách này thì tôi biết, nhưng đang bị lỗi không chạy được. Với file VD mẫu ở bài 1 thì chạy tốt nhưng dùng file khác thì nó lại báo lỗi như sau:

 

[befaint]

. Với file VD mẫu ở bài 1 thì chạy tốt nhưng dùng file khác thì nó lại báo lỗi như sau:

Anh thử đính kèm 1 file bị lỗi này xem. Chắc còn code nào đó xem vào...

 

[giaiphap]

Anh thử đính kèm 1 file bị lỗi này xem. Chắc còn code nào đó xem vào...

Ồ được rồi các bạn ơi, mình đã khắc phục được rồi.

 

[phulien1902]

Ồ được rồi các bạn ơi, mình đã khắc phục được rồi.

Bác giaiphap vui lòng chỉ giúp là bác đã khắc phục như thế nào mà sau khi tách thành File mới lại không còn Code
( Private Sub Worksheet_Change(ByVal Target As Range)...........) không?
Tôi cũng gặp trường hợp như vậy, nên muốn được bác chia sẻ.
Xin cảm ơn.

 

[be_09]

Bác giaiphap vui lòng chỉ giúp là bác đã khắc phục như thế nào mà sau khi tách thành File mới lại không còn Code
( Private Sub Worksheet_Change(ByVal Target As Range)...........) không?
Tôi cũng gặp trường hợp như vậy, nên muốn được bác chia sẻ.
Xin cảm ơn.

Cái này tôi nghĩ là bạn dư sức làm, bạn có thể làm thử cách làm với sheet phụ.
Khi lọc xong thì dùng sheet phụ xuất File (vậy là chẳng cần suy nghĩ đến ba cái code, ba cái Shapes).

 

[giaiphap]

Bác giaiphap vui lòng chỉ giúp là bác đã khắc phục như thế nào mà sau khi tách thành File mới lại không còn Code
( Private Sub Worksheet_Change(ByVal Target As Range)...........) không?
Tôi cũng gặp trường hợp như vậy, nên muốn được bác chia sẻ.
Xin cảm ơn.

Cách làm của mình giống như @be09 nói đó là tạo sheet phụ, khăc phục được một số cái như name trong sheet, data validation trong sheet, shape...

 

[Mutants Men]

Cách làm của mình giống như @be09 nói đó là tạo sheet phụ, khăc phục được một số cái như name trong sheet, data validation trong sheet, shape...

nếu không là sheet phụ thì xử dụng cách sau để xử lý code trong sheet đó luông
code sau để check mục VBAprọect như hình hpkhuong cung cấp #8

Public Sub ChangeVBOM(ByVal Val As Long)
'Val = 1: check
'Val = 0: uncheck
    Dim Regkey As String, App As String
    App = AppVersion()
    Regkey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & CreateObject("Excel.Application").Version & "\Excel\Security\AccessVBOM"
    CreateObject("WScript.Shell").RegWrite Regkey, Val, "REG_DWORD"
End Sub

để xóa code trong đối tượng nào đó thì có thể dùng code sau

Sub InsertCode(ByVal Wb As Workbook, ByVal mName As String, Optional ByVal NoiDung As String = "Option Explicit")
ChangeVBOM 1
'Wb: Workbook thao tac
'mName: ten doi tuong thao tac' su dung Codename
'NoiDung: noi dung code
    Dim VBComp As Object
    With Wb.VBProject.VBComponents(mName).CodeModule
        .DeleteLines 1, .CountOfLines    'xoa code cu
        .InsertLines 1, NoiDung    'chen noi dung code
    End With
ChangeVBOM 0
End Sub

ví dụ muốn xóa điền chữ "Noi dung code ne" trong Sheet1 của Workbook đang chọn

Sub TestCode()
InsertCode ActiveWorkbook, "Sheet1", "'Noi dung code ne"
End Sub

 

[giaiphap]

nếu không là sheet phụ thì xử dụng cách sau để xử lý code trong sheet đó luông
code sau để check mục VBAprọect như hình hpkhuong cung cấp #8

Public Sub ChangeVBOM(ByVal Val As Long)
'Val = 1: check
'Val = 0: uncheck
    Dim Regkey As String, App As String
    App = AppVersion()
    Regkey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & CreateObject("Excel.Application").Version & "\Excel\Security\AccessVBOM"
    CreateObject("WScript.Shell").RegWrite Regkey, Val, "REG_DWORD"
End Sub

để xóa code trong đối tượng nào đó thì có thể dùng code sau

Sub InsertCode(ByVal Wb As Workbook, ByVal mName As String, Optional ByVal NoiDung As String = "Option Explicit")
ChangeVBOM 1
'Wb: Workbook thao tac
'mName: ten doi tuong thao tac' su dung Codename
'NoiDung: noi dung code
    Dim VBComp As Object
    With Wb.VBProject.VBComponents(mName).CodeModule
        .DeleteLines 1, .CountOfLines    'xoa code cu
        .InsertLines 1, NoiDung    'chen noi dung code
    End With
ChangeVBOM 0
End Sub

ví dụ muốn xóa điền chữ "Noi dung code ne" trong Sheet1 của Workbook đang chọn

Sub TestCode()
InsertCode ActiveWorkbook, "Sheet1", "'Noi dung code ne"
End Sub

Cảm ơn bạn cách này mình cũng thử rồi, nhưng không biết sao vẫn bị lỗi ở file của mình (File của mình có sử dụng code can thiệp nghiều vào sheet). Một giải pháp như mình nói ở #9 đã khắc phục được.

 

[Mutants Men]

Cảm ơn bạn cách này mình cũng thử rồi, nhưng không biết sao vẫn bị lỗi ở file của mình (File của mình có sử dụng code can thiệp nghiều vào sheet). Một giải pháp như mình nói ở #9 đã khắc phục được.

chỗ này
File của mình có sử dụng code can thiệp nghiều vào sheet
nên dùng class
hoặc nếu dùng phương thức worksheet_change
thì có thể dùng lệnh sau thay thế xem sao

Sub auto_open()
    Application.OnEntry = "MySub"
End
End Sub
Sub MySub()
    If Not Application.Intersect(ActiveCell, Range("A1:B10")) Is Nothing Then
        If TypeName(ActiveCell.Value) <> "Double" Then MsgBox "Nhap sai roi, hic!"
    End If
End Sub

có thể tham khảo thêm vài thứ có thể thay thế class sự kiện như ví dụ trên tại đây

 

[be_09]

Thử.
Trong sheet Danhsach với code này:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [C2]) Is Nothing Then
        MsgBox "Ban vua thay doi gia tri o C2"
    End If
    Call BoDinhDang
End Sub

Trong Module với code này:

Sub BoDinhDang()
'Chi luu du lieu
    Dim wb1 As Workbook, wb2 As Workbook
    Dim s1 As Worksheet, s2 As Worksheet
    Dim DuLieu As Variant
    Set wb1 = ThisWorkbook
    Set s1 = wb1.Sheets("Danhsach")
    Set wb2 = Workbooks.Add
    Set s2 = wb2.Sheets("Sheet1")
   
    DuLieu = s1.UsedRange.Formula
    s2.Range("A1").Resize(UBound(DuLieu, 1), UBound(DuLieu, 2)).Formula = DuLieu
    Columns("B:B").NumberFormat = "dd/mm/yy"
End Sub

 

[giaiphap]

Thử.
Trong sheet Danhsach với code này:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [C2]) Is Nothing Then
        MsgBox "Ban vua thay doi gia tri o C2"
    End If
    Call BoDinhDang
End Sub

Trong Module với code này:

Sub BoDinhDang()
'Chi luu du lieu
    Dim wb1 As Workbook, wb2 As Workbook
    Dim s1 As Worksheet, s2 As Worksheet
    Dim DuLieu As Variant
    Set wb1 = ThisWorkbook
    Set s1 = wb1.Sheets("Danhsach")
    Set wb2 = Workbooks.Add
    Set s2 = wb2.Sheets("Sheet1")
  
    DuLieu = s1.UsedRange.Formula
    s2.Range("A1").Resize(UBound(DuLieu, 1), UBound(DuLieu, 2)).Formula = DuLieu
    Columns("B:B").NumberFormat = "dd/mm/yy"
End Sub

Hay quá anh ơi, cách này thấy ngon quá. Đã test và thấy phù hợp với cách này.