làm thế nào chép đoạn code vào Thisworkbook bằng VBA?

[ongtrungducmx25]

em có đoạn code sao đây em muốn copy đoạn code đó vào Thisworkbook bằng vba, khi mở một trang mới thì em muốn chép cái code đó vào trang book2, hoặc mở tiếp một book3 thì cũng thế các pác chỉ giúp giùm em nhé!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Er As Integer, Max As Integer
If Not Intersect(Range("C2:C100"), Target) Is Nothing Then
Er = Range("C1000").End(xlUp).Row
For I = 9 To Er
Max = Application.WorksheetFunction.Max(Range("B8:B" & I - 1))
If Cells(I, 2).MergeCells = False Then
Cells(I, 2).Value = Max + 1
End If
Next I
End If
End Sub

chép vào thisworkbook rồi tạo thêm nút xóa code trong thisworkbook luôn nhé!thank nhiều

 

[chibi]

Bạn xem bài này của bác Voda, hình như đáp ứng được yêu cầu của bạn.

 

[ongtrungducmx25]

em muốn chép vào thisworkbook khi mở một book1 mới thisworkbook chưa có code thì em bổ sung ,còn muốn xóa đi thì cũng làm tương tự như thế nhé!còn code này thì em chưa hiểu lăm

-Nếu code nằm trong sheet, ta dùng câu lệnh:
With Workbooks("book1.xls").VBProject.VBComponents("cod ename của sheet").CodeModule
-Nếu code trong ThisWorkbook:
With Workbooks("book1.xls").VBProject.VBComponents("Thi sWorkbook").CodeModule
-Nếu code trong Userform:
With Workbooks("book1.xls").VBProject.VBComponents("Use rform1").CodeModule

 

[voda]

-Trong một Workbook, ngoài Classe Modules, code được đặt vào 4 vị trí tùy yêu cầu của chương trình:
1.ThisWorkbook. 2. Các Sheets. 3. Các Modules. 4. Các Userforms
-Muốn tác động vào code ở vị trí nào, ta phải dùng câu lệnh phù hợp như phần bạn trích dẫn.

 

[dat2007]

Bạn nghiên cứu đoạn Code sau

Sub AddSheetCode() 
    Dim strCode As String 
    Dim FWord As String 
    Dim WB As Workbook 
    Dim Sh 
    Dim I As Integer 
    Set WB = ActiveWorkbook 
      
    strCode = "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)" & vbCr _ 
    & "If Sh.Name = " & Chr(34) & "FindWord" & Chr(34) & " Then" & vbCr _ 
    & "If Target.Address = " & Chr(34) & "$B$1" & Chr(34) & " Then" & vbCr _ 
    & "Application.Run (" & Chr(34) & "Personal.xls!Search.FindAll" & Chr(34) & "), Target.Text, " & Chr(34) & "False" & Chr(34) & vbCr _ 
    & "Cells(1,2).Select" & vbCr _ 
    & "End if" & vbCr _ 
    & "End if" & vbCr _ 
    & "End Sub" 
    
    FWord = "ThisWorkbook" 
    For I = 1 To WB.VBProject.VBComponents.Count 
        If WB.VBProject.VBComponents.Item(I).Name = FWord Then 
            Exit For 
        End If 
    Next 
    If Not WB.VBProject.VBComponents.Item(I).CodeModule Is Nothing Then 
        If Not WB.VBProject.VBComponents.Item(I).CodeModule.Find("Workbook_SheetChange", 1, 1, 100, 100) Then 
            WB.VBProject.VBComponents.Item(I).CodeModule.AddFromString (strCode) 
        End If 
    End If 
    Set WB = Nothing 
     
End Sub

Nhớ chọn : Trust access to the VBA ... trong Macro Settings. Xem thêm trong File gửi kèm

 

[ongtrungducmx25]

kiểu trên khó wá em mò hoài cũng không được, nó báo lỗi nhìn mà nhứt mắt quá!