Xóa một sub trong module

One Response

1. hands says:

   18/01/2023 at 3:11 pm

   Có điều chắc chắn là ta không thể nhớ chính xác tên đối tượng cần xóa. Vậy cần thêm 1 thủ tục để lấy tên các đối tượng ra ngoài bảng tính, khi muốn xóa đối tượng nào ta chọn nó rồi xóa bằng sự kiện phải chuột hoặc đúp chuột. Không biết ý tưởng đó có làm được không (tôi thì chịu)

   Đương nhiên được chứ anh
   Ví dụ code lấy các Procedures trong 1 Module

   Function ListProcedures(ByVal ModuleName As String)
   Dim LineNum As Long, NumLines As Long, i As Long, Arr(), ProcName As String
   With ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule
   LineNum = .CountOfDeclarationLines + 1
   Do Until LineNum >= .CountOfLines
   ProcName = .ProcOfLine(LineNum, 0)
   ReDim Preserve Arr(i)
   Arr(i) = ProcName: i = i + 1
   LineNum = .ProcStartLine(ProcName, 0) + _
   .ProcCountLines(ProcName, 0) + 1
   Loop
   End With
   ListProcedures = Arr
   End Function

   Áp dụng =ListProcedures("Module1") —> Sẽ lấy tên các Procedures trong Module1

   Ndu cho file ví dụ xem áp dụng như thế nào. Mình vào bảng tính (có 2 Module 1 chứa code này, 1 chứa code khác) và nhập công thức =ListProcedures("Module1") đã thử với tên Module1 và Module2 nhưng kết quả vẫn là #VALUE!

   Anh xem file dưới đây nhé

   Có thể lỗi xảy ra tại Trusted Center không anh? Phải check vào đó nó mới cho chạy code đấy!

   @ Nghĩa: đúng là tại Trusted.

   Anh xem file dưới đây nhé

   @ Ndu: Hàm ListProcedures("Module1") thì được rồi nhưng mình muốn danh sách này được liệt kê ra bảng tính mình thử code dưới thì được nhưng không biết trong Module1 có bao nhiêu Macro để thay vào cái chỗ số 5 ?

   Sub LisModule()
     [d2].Resize([B][COLOR=#ff0000]5[/COLOR][/B]) = WorksheetFunction.Transpose(ListProcedures("Module1"))
   End Sub

   Còn vấn đề nữa là nhờ bạn giúp tiếp hàm lấy các Module của File ra ngoài bảng tính.

   Thì anh làm vầy

   Sub LisModule()
       Dim Arr
       Arr = ListProcedures("Module1")
       [d2].Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(ListProcedures("Module1"))
   End Sub

   Ubound(Arr) chính là cái anh cần
   ——————–
   Còn vụ lấy listModule, em nghĩ chắc là vầy:

   Function ListModule()
   Dim mod_ As VBComponent
   Dim n As Long
   Dim Arr()
   For Each mod_ In ActiveWorkbook.VBProject.VBComponents
   If mod_.Type = 1 Then
   n = n + 1
   ReDim Preserve Arr(1 To n)
   Arr(n) = mod_.Name
   End If
   Next
   If n Then ListModule = Arr
   End Function
   —————–
   Oh mà xem lại thì thấy mấy bài cuối chẳng ăn nhậu gì đến vụ DÙNG CODE VBA ĐỂ XÓA VBA cả. Anh TrungChinhs có thấy vậy không?
   Ẹc… Ẹc… lộn tiệm dễ bị mod xóa bài quá

   Ấy… ấy… sao lại không ? Tại #123 tôi đã nêu rõ mục đích rồi mà. Tôi đang muốn lấy các Module và các Macro ra ngoài bảng tính sau đó dùng code của Siwtom tại # 119 để xóa. Mấy bài vừa rồi sẽ giúp cho việc thay tên đối tượng cần xóa trong Code của Siwtom bằng Selection.value.

   Nếu có thời gian thì Ndu tiếp tục xem nào. Tôi sẽ thử tiếp, chỉ hiềm một nỗi là tôi không hiểu lắm các câu lệnh nên chỉ thực hiện máy móc theo kiểu thay thế IC thôi.
   Hic đọc lại bài 119 thì ra là code xóa dòng trong Macro chứ không phải là code xóa Module hoặc xóa Macro nên Botay.com luôn.
   Từ 2 bài của Ndu tôi mới làm được đến đây (xem file đính kèm). Bạn nào biết, viết giúp mình code Delete Macro và Remove Module. Thanks !

   Thì lỗi của bạn thôi. Lần sau đọc cho kỹ nhé.
   Mà "xóa dòng" là không chính xác (xóa vài dòng trong SUB, trong MODULE? – làm gì có chuyện đó). Code xóa toàn bộ code của 1 hàm, phương thức có tên cho trước trong module có tên cho trước trong book cho trước.
   Tôi thường đọc kỹ bài của người khác.
   Code không xóa Module mà chỉ xóa hàm trong Module vì người hỏi viết: "Xin hỏi các chuyên gia có code nào xóa một sub trong module không"

   ———————–
   Bạn viết code buồn cười thật. Sao bạn cứ gọi một code 2 lần kiểu như:

   Arr = ListProcedures(Selection)
   Selection(1, 2).Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(ListProcedures(Selection))

   Bạn gọi 1 lần là được:

   Arr = ListProcedures(Selection)
   Selection(1, 2).Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(Arr)

   ————

   Để bạn làm được các việc đã nêu thì tôi cho bạn những code dưới đây. Chú ý:
   1. DeleteProcedureCode không chỉ xóa code của hàm và sub trong Module mà cả code trong UserForm, Sheet1, 2, 3, ThisWorkBook (với CompName = "UserForm1", "Sheet1", "ThisWorkBook")

   2. Tôi viết các hàm liệt kê đòi hỏi thông số WorkBook vì tôi muốn viết hàm tổng quát thao tác trên WorkBook bất kỳ (khi có nhiều WorkBook mở cùng lúc) chứ không chỉ trên ActiveWorkBook.
   Nếu bạn chỉ cần thao tác trên ActiveWorkBook thôi thì truyền ActiveWorkBook vào thông số.

   ' [COLOR=#ff0000]liệt kê các hàm, sub có trong CompName (Sheet, ThisWorkBook, UserForm, Module)[/COLOR]
   Function ListFunctions(ByVal book As Workbook, ByVal CompName As String)
   '   Microsoft Visual Basic for Applications Extensibility
   ' Trả về danh sách hàm có trong CompName
   Dim currLine As Long, k As Long, name As String, Arr()
       With book.VBProject.VBComponents(CompName).CodeModule
           currLine = .CountOfDeclarationLines + 1
           Do Until currLine >= .CountOfLines
               ReDim Preserve Arr(0 To k)
               name = .ProcOfLine(currLine, vbext_pk_Proc)
               Arr(k) = name
               currLine = currLine + .ProcCountLines(name, vbext_pk_Proc)
               k = k + 1
           Loop
       End With
       ListFunctions = Arr
   End Function
   
   '[COLOR=#ff0000] liệt kê các component (sheet, thisworkbook, userform, module, class module) có trong workbook[/COLOR]
   Function ListComponents(ByVal book As Workbook)
   '   tham chieu: Microsoft Visual Basic for Applications Extensibility
   Dim VBComp As VBIDE.VBComponent, Arr(), k As Long
       For Each VBComp In book.VBProject.VBComponents
           ReDim Preserve Arr(0 To k)
           Arr(k) = VBComp.name
           k = k + 1
       Next VBComp
       ListComponents = Arr
   End Function
   
   '  [COLOR=#ff0000]xóa Module, Form, Class Module khỏi book[/COLOR]
   Sub DeleteVBComponent(ByVal book As Workbook, ByVal CompName As String)
   ' cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
   ' xóa vbcomponent có tên là CompName khỏi bảng tính wb
   '    vbcomponent là Module, Class Module, Form
   '    vd. DeleteVBComponent Workbooks("vbe.xls"), "class1"
   '    DeleteVBComponent Workbooks("vbe.xls"), "module3"
   '    DeleteVBComponent Workbooks("vbe.xls"), "myForm"
   Dim VBCp As VBComponents
       Application.DisplayAlerts = False
       On Error Resume Next
       Set VBCp = book.VBProject.VBComponents
       If Not VBCp Is Nothing Then VBCp.Remove VBCp(CompName)
       Set VBCp = Nothing
       On Error GoTo 0
       Application.DisplayAlerts = True
   End Sub
   
   ' [COLOR=#ff0000]xóa nội dung của Module nhưng vẫn giữ Module[/COLOR]
   Sub DeleteModuleContent(ByVal book As Workbook, ByVal CompName As String)
   '   cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
   '   xóa nội dung (không xóa CompName) của module có tên là CompName trong bảng tính book
   '    vd. DeleteModuleContent Workbooks("vbe.xls"), "module3"
       On Error Resume Next
       With book.VBProject.VBComponents(CompName).CodeModule
           .DeleteLines 1, .CountOfLines
       End With
       On Error GoTo 0
   End Sub
   
   ' [COLOR=#ff0000]xóa code của hàm trong Module, UserForm, Sheet1, 2, 3, ThisWorkBook[/COLOR]
   Sub DeleteProcedureCode(ByVal book As Workbook, _
       ByVal CompName As String, ByVal ProcedureName As String)
   ' cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
   ' xóa ProcedureName khỏi CompName trong bảng tính book
   'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
   Dim VBCM As CodeModule, ProcStartLine As Long, ProcLineCount As Long
       On Error Resume Next
   '    module có phương thức cần xóa
       Set VBCM = book.VBProject.VBComponents(CompName).CodeModule
       If Not VBCM Is Nothing Then
   '        tìm dòng đầu của phương thức (kể cả các dòng ghi chú ở trước Function, Sub ProcedureName)
   '        nếu trả về 0 thì có nghĩa là phương thức không tồn tại
           ProcStartLine = VBCM.ProcStartLine(ProcedureName, vbext_pk_Proc)
           If ProcStartLine > 0 Then
   '            tổng số dòng của phương thức
               ProcLineCount = VBCM.ProcCountLines(ProcedureName, vbext_pk_Proc)
   '            xóa tất cả các dòng của phương thức
               VBCM.DeleteLines ProcStartLine, ProcLineCount
           End If
           Set VBCM = Nothing
       End If
       On Error GoTo 0
   End Sub

   À, tôi là siwtom chứ không phải là Wistom

   Cảm ơn Thầy Siwtom rất nhiều về những bài viết trong Topic này.
   Xin lỗi thầy về vụ gõ nhầm tên, em đã sửa lại.
   Còn về cách viết, đối với những vấn đề mới lạ nhiều khi em cứ bị ngô nghê như vậy mà không nhận ra.

   Về yêu cầu của bạn là liệt kê và xóa các Function và Sub (macro) thì tôi đã gửi code.
   Nhưng tôi muốn sửa 2 code để có thể liệt kê và xóa cả các property procedures (các property procedures Get, Let, Set trong class module)
   Dưới đây tôi gửi lại code của Sub / Function. Những chỗ mầu đỏ là được thêm vào, chỗ mầu xanh là sửa (trước đó là vbext_pk_Proc, bây giờ là ProcKind)
   Bây giờ thì tôi tin là code thao tác cho Sheet, ThisWorkbook, UserForm, Module và Class Module, tức "trọn gói".

   Sub DeleteProcedureCode(ByVal wb As Workbook, _
       ByVal CompName As String, ByVal ProcedureName As String)
   ' cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
   ' xóa ProcedureName khỏi CompName trong bảng tính wb
   'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
   Dim VBCM As CodeModule, ProcStartLine As Long, ProcLineCount As Long, [COLOR=#ff0000]ProcKind As Long[/COLOR]
   '    module có phương thức cần xóa
       Set VBCM = wb.VBProject.VBComponents(CompName).CodeModule
       If Not VBCM Is Nothing Then
           [COLOR=#ff0000]On Error GoTo errHandler[/COLOR]
   '        tìm dòng đầu của phương thức (kể cả các dòng ghi chú ở trước Function, Sub ProcedureName)
   '        nếu trả về 0 thì có nghĩa là phương thức không tồn tại
           ProcStartLine = VBCM.ProcStartLine(ProcedureName, [COLOR=#0000ff]ProcKind[/COLOR])
           If ProcStartLine > 0 Then
   '            tổng số dòng của phương thức
               ProcLineCount = VBCM.ProcCountLines(ProcedureName,[COLOR=#0000ff] ProcKind[/COLOR])
   '            xóa tất cả các dòng của phương thức
               VBCM.DeleteLines ProcStartLine, ProcLineCount
           End If
           Set VBCM = Nothing
       End If
       Exit Sub
   [COLOR=#ff0000]errHandler:
       If Err.Number = 35 And ProcKind < 3 Then
           ProcKind = ProcKind + 1
           Resume
       End If
   [/COLOR]End Sub
   
   Function ListFunctions(ByVal wb As Workbook, ByVal CompName As String)
   '   Microsoft Visual Basic for Applications Extensibility
   ' Trả về danh sách hàm có trong module
   Dim currLine As Long, k As Long, name As String, Arr(), size As Long, [COLOR=#ff0000]ProcKind As Long[/COLOR]
       With wb.VBProject.VBComponents(CompName).CodeModule
           currLine = .CountOfDeclarationLines + 1
           [COLOR=#ff0000]On Error GoTo errHandler[/COLOR]
           Do Until currLine >= .CountOfLines
               ReDim Preserve Arr(0 To k)
               name = .ProcOfLine(currLine, [COLOR=#0000ff]ProcKind[/COLOR])
               Arr(k) = name
               currLine = currLine + .ProcCountLines(name, [COLOR=#0000ff]ProcKind[/COLOR])
               k = k + 1
           Loop
       End With
       ListFunctions = Arr
       Exit Function
   [COLOR=#ff0000]errHandler:
       If Err.Number = 35 And ProcKind < 3 Then
           ProcKind = ProcKind + 1
           Resume
       End If
   [/COLOR]End Function

   Reply