Tự tạo ra sự kiện trong worksheet khi chạy macro

An.BA · 9/7/21

Em có 1 đoạn code để áp dụng vào sự kiện change_sheet. Nhưng thay vì vào code vba rồi chọn sự kiện rồi patse code vào trong sự kiện đó thì em muốn khi chạy macro thì nó tự sinh ra sự kiện của worksheet và kèm đoạn code của em.
Em cảm ơn!

giaiphap · 9/7/21

An.BA đã viết:
Em có 1 đoạn code để áp dụng vào sự kiện change_sheet. Nhưng thay vì vào code vba rồi chọn sự kiện rồi patse code vào trong sự kiện đó thì em muốn khi chạy macro thì nó tự sinh ra sự kiện của worksheet và kèm đoạn code của em.
Em cảm ơn!

Dùng thử code này. Nói trước là còn nhiều cái phát sinh lắm nghe, chỉ trả lời cái bạn cần thôi.

Mã:

Sub AddCode()
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
   .InsertLines 1, "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)"
   .InsertLines 2, "   'Code cua ban dat o day"
   .InsertLines 3, "End Sub"
End With
End Sub

An.BA · 9/7/21

giaiphap đã viết:
Dùng thử code này. Nói trước là còn nhiều cái phát sinh lắm nghe, chỉ trả lời cái bạn cần thôi.

Mã:

Sub AddCode() With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule .InsertLines 1, "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)" .InsertLines 2, " 'Code cua ban dat o day" .InsertLines 3, "End Sub" End With End Sub

Vâng. Em cảm ơn để em thử nếu gặp phát sinh khác sẽ hỏi tiếp vì giờ em cần như vậy thôi.

Maika8008 · 9/7/21

An.BA đã viết:
Vâng. Em cảm ơn để em thử nếu gặp phát sinh khác sẽ hỏi tiếp vì giờ em cần như vậy thôi.

Nếu code báo lỗi (hoặc không báo lỗi nhưng không thêm các dòng mã VBA cần thêm) thì vào File -> Options -> Trust Center -> Trust Center Settings... -> Macrro Setting -> Chọn Trust Access to the VBA project object model

An.BA · 9/7/21

giaiphap đã viết:
Dùng thử code này. Nói trước là còn nhiều cái phát sinh lắm nghe, chỉ trả lời cái bạn cần thôi.

Mã:

Sub AddCode() With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule .InsertLines 1, "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)" .InsertLines 2, " 'Code cua ban dat o day" .InsertLines 3, "End Sub" End With End Sub

Bác ơi. cho em xin tạo vào WorkSheet nữa với ạ.
Em thay thế name nhưng không được ạ.
Em cảm ơn!

An.BA · 10/7/21

Em truyền vào tham số là ActiveSheet.name nhưng nó không chuẩn lắm nếu tên sheet nhìn thấy với tên sheet nhìn ở vba.

giaiphap · 10/7/21

An.BA đã viết:
Bác ơi. cho em xin tạo vào WorkSheet nữa với ạ.
Em thay thế name nhưng không được ạ.
Em cảm ơn!

Mã:

Sub AddCode()
With ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
   .InsertLines 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
   .InsertLines 2, "   'Code cua ban dat o day"
   .InsertLines 3, "End Sub"
End With
End Sub

Với Sheet1 chính là tên Sheet (Name Code) của bạn. Trên hình GPE là tên hiển thị ở ngoài sheet còn Sheet1 là cái cần gõ vào.

An.BA · 10/7/21

giaiphap đã viết:
Mã:

Sub AddCode() With ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule .InsertLines 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" .InsertLines 2, " 'Code cua ban dat o day" .InsertLines 3, "End Sub" End With End Sub

Với Sheet1 chính là tên Sheet (Name Code) của bạn. Trên hình GPE là tên hiển thị ở ngoài sheet còn Sheet1 là cái cần gõ vào.
View attachment 262176 View attachment 262177

Đó cái em cần là tên sheet trong VBA đó ạ.
VBProject.VBComponents("Sheet1") chỗ này em muốn thay thế là VBProject.VBComponents(AcitveSheet.name) thì nó không đúng vì nó lại đọc sang tên mình nhìn thấy. còn thằng code để sinh ra sự kiện nó lại bắt vào tên thằng VBA cơ ạ

Bài đã được tự động gộp: 10/7/21

và bác cho em xin đoạn code check xem hàm nó được tạo chưa ạ vì em bấm lần 2 thì bị lỗi rồi ạ

Em cảm ơn

batman1 · 10/7/21

An.BA đã viết:
Đó cái em cần là tên sheet trong VBA đó ạ.
VBProject.VBComponents("Sheet1") chỗ này em muốn thay thế là VBProject.VBComponents(AcitveSheet.name)

Phải là ActiveSheet.CodeName

giaiphap · 11/7/21

An.BA đã viết:
bác cho em xin đoạn code check xem hàm nó được tạo chưa ạ vì em bấm lần 2 thì bị lỗi rồi ạ
Em cảm ơn

Trước hết bật thư viện như hình.

Sau đó dùng thử code này xem sao.

Mã:

Sub AddCode()
    If Not ProcedureExists("Worksheet_SelectionChange", ActiveSheet) Then
        With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
           .InsertLines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
           .InsertLines 3, "   'Code cua ban dat o day"
           .InsertLines 4, "End Sub"
        End With
    Else
        MsgBox "Worksheet_SelectionChange da ton tai"
    End If
End Sub
Function ProcedureExists(subName As String, wh As Worksheet) As Boolean
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim procName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
        ProcedureExists = False
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(wh.CodeName)
        Set CodeMod = VBComp.CodeModule
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                procName = .ProcOfLine(LineNum, ProcKind)
                If UCase(subName) = UCase(procName) Then
                    ProcedureExists = True
                    Exit Do
                End If
                LineNum = .ProcStartLine(procName, ProcKind) + .ProcCountLines(procName, ProcKind) + 1
            Loop
        End With
End Function

An.BA · 11/7/21

giaiphap đã viết:

Trước hết bật thư viện như hình.
View attachment 262223
Sau đó dùng thử code này xem sao.

Mã:

Sub AddCode()
    If Not ProcedureExists("Worksheet_SelectionChange", ActiveSheet) Then
        With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
           .InsertLines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
           .InsertLines 3, "   'Code cua ban dat o day"
           .InsertLines 4, "End Sub"
        End With
    Else
        MsgBox "Worksheet_SelectionChange da ton tai"
    End If
End Sub
Function ProcedureExists(subName As String, wh As Worksheet) As Boolean
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim procName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
        ProcedureExists = False
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(wh.CodeName)
        Set CodeMod = VBComp.CodeModule
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                procName = .ProcOfLine(LineNum, ProcKind)
                If UCase(subName) = UCase(procName) Then
                    ProcedureExists = True
                    Exit Do
                End If
                LineNum = .ProcStartLine(procName, ProcKind) + .ProcCountLines(procName, ProcKind) + 1
            Loop
        End With
End Function

Em cảm ơn nhiều ạ.

Tự tạo ra sự kiện trong worksheet khi chạy macro

An.BA

Thành viên thường trực

giaiphap

==(^o^)==

An.BA

Thành viên thường trực

Maika8008

Thành viên gạo cội

An.BA

Thành viên thường trực

An.BA

Thành viên thường trực

giaiphap

==(^o^)==

An.BA

Thành viên thường trực

batman1

Thành viên gạo cội

giaiphap

==(^o^)==

An.BA

Thành viên thường trực

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

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