Hiển thị các Sub và Function trong Modul ra ngoài excel

vanaccex · 4/10/18

Em có 1 File excel gồm nhiều Sub và Function trong nhiều Modull. em Muốn đặt công thức để có thể hiện được các sub và function này thuộc file đó ra ngoài Sheet ( Trang Tính ) như kết quả em muốn trong File. Anh (chị )! giúp em với ạ !. Em cảm ơn ạ

HaCoChu · 4/10/18

vanaccex đã viết:
Em có 1 File excel gồm nhiều Sub và Function trong nhiều Modull. em Muốn đặt công thức để có thể hiện được các sub và function này thuộc file đó ra ngoài Sheet ( Trang Tính ) như kết quả em muốn trong File. Anh (chị )! giúp em với ạ !. Em cảm ơn ạ

Bạn qua đây xem

be_09 · 4/10/18

HaCoChu đã viết:
Bạn qua đây xem

Chắc không được rồi, chỉ có lưu lại thành Add In thì sử dụng cho bất kỳ File nào cũng được.

ndu96081631 · 4/10/18

vanaccex đã viết:
Em có 1 File excel gồm nhiều Sub và Function trong nhiều Modull. em Muốn đặt công thức để có thể hiện được các sub và function này thuộc file đó ra ngoài Sheet ( Trang Tính ) như kết quả em muốn trong File. Anh (chị )! giúp em với ạ !. Em cảm ơn ạ

List các modules:

Mã:

Function ListModules(Optional ByVal wkb As Workbook)
  Dim n As Long, lCount As Long
  If wkb Is Nothing Then Set wkb = ThisWorkbook
  lCount = wkb.VBProject.VBComponents.Count
  ReDim arr(1 To lCount)
  For n = 1 To lCount
    arr(n) = wkb.VBProject.VBComponents(n).Name
  Next
  ListModules = arr
End Function

List các thủ tục trong 1 module:

Mã:

Function ListProcedures(ByVal ModuleName As String)
  Dim line As Long, i As Long
  Dim arr()
  Dim procName As String
  With ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule
    line = .CountOfDeclarationLines + 1
    Do Until line >= .CountOfLines
      procName = .ProcOfLine(line, 0)
      ReDim Preserve arr(i)
      arr(i) = procName
      i = i + 1
      line = .ProcStartLine(procName, 0) + .ProcCountLines(procName, 0) + 1
    Loop
  End With
  ListProcedures = arr
End Function

Ghi chú:
- Code mặc định xem như đang nói đến ActiveWorkbook
- Code chỉ hoạt động được khi mục " Trust access to the VBA..." trong Excel Options đã được check

vanaccex · 4/10/18

ndu96081631 đã viết:

List các modules:

Mã:

Function ListModules(Optional ByVal wkb As Workbook)
  Dim n As Long, lCount As Long
  If wkb Is Nothing Then Set wkb = ThisWorkbook
  lCount = wkb.VBProject.VBComponents.Count
  ReDim arr(1 To lCount)
  For n = 1 To lCount
    arr(n) = wkb.VBProject.VBComponents(n).Name
  Next
  ListModules = arr
End Function

List các thủ tục trong 1 module:

Mã:

Function ListProcedures(ByVal ModuleName As String)
  Dim line As Long, i As Long
  Dim arr()
  Dim procName As String
  With ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule
    line = .CountOfDeclarationLines + 1
    Do Until line >= .CountOfLines
      procName = .ProcOfLine(line, 0)
      ReDim Preserve arr(i)
      arr(i) = procName
      i = i + 1
      line = .ProcStartLine(procName, 0) + .ProcCountLines(procName, 0) + 1
    Loop
  End With
  ListProcedures = arr
End Function

Ghi chú:
- Code mặc định xem như đang nói đến ActiveWorkbook
- Code chỉ hoạt động được khi mục " Trust access to the VBA..." trong Excel Options đã được check

Dạ vâng em cảm ơn anh ạ để em thử ạ

zou · 4/10/18

ndu96081631 đã viết:

List các modules:

Mã:

Function ListModules(Optional ByVal wkb As Workbook)
  Dim n As Long, lCount As Long
  If wkb Is Nothing Then Set wkb = ThisWorkbook
  lCount = wkb.VBProject.VBComponents.Count
  ReDim arr(1 To lCount)
  For n = 1 To lCount
    arr(n) = wkb.VBProject.VBComponents(n).Name
  Next
  ListModules = arr
End Function

List các thủ tục trong 1 module:

Mã:

Function ListProcedures(ByVal ModuleName As String)
  Dim line As Long, i As Long
  Dim arr()
  Dim procName As String
  With ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule
    line = .CountOfDeclarationLines + 1
    Do Until line >= .CountOfLines
      procName = .ProcOfLine(line, 0)
      ReDim Preserve arr(i)
      arr(i) = procName
      i = i + 1
      line = .ProcStartLine(procName, 0) + .ProcCountLines(procName, 0) + 1
    Loop
  End With
  ListProcedures = arr
End Function

Ghi chú:
- Code mặc định xem như đang nói đến ActiveWorkbook
- Code chỉ hoạt động được khi mục " Trust access to the VBA..." trong Excel Options đã được check

Bạn ơi làm như thế nào để liệt kê ra các ô trong bảng tính vậy bạn?

vanaccex · 4/10/18

Đây là công thức mảng thì kết thúc bằng ctrl + shift + enter

zou · 4/10/18

vanaccex đã viết:
Đây là công thức mảng thì kết thúc bằng ctrl + shift + enter

Ồ, mình cứ tưởng lại viết sub nào gọi 2 cái ra để chạy.
nếu viết sub gọi thì viết thế nào vậy bạn?

HaCoChu · 5/10/18

zou đã viết:
Ồ, mình cứ tưởng lại viết sub nào gọi 2 cái ra để chạy.
nếu viết sub gọi thì viết thế nào vậy bạn?

Yết úp ì yết ầy è

Mã:

Sub LietkeFuncAndsub()
    Dim Arr(), dArr, I As Long, Er As Long
        On Error Resume Next
Arr = ListModules()
For I = LBound(Arr) To UBound(Arr)
    Er = Range("B" & Rows.Count).End(xlUp).Row + 1
    dArr = ListProcedures(Arr(I))
    Range("A" & Er) = Arr(I)
    Range("B" & Er).Resize(UBound(dArr) + 1) = WorksheetFunction.Transpose(dArr)
Next I
End Sub

ndu96081631 · 5/10/18

HaCoChu đã viết:

Yết úp ì yết ầy è

Mã:

Sub LietkeFuncAndsub()
    Dim Arr(), dArr, I As Long, Er As Long
        On Error Resume Next
Arr = ListModules()
For I = LBound(Arr) To UBound(Arr)
    Er = Range("B" & Rows.Count).End(xlUp).Row + 1
    dArr = ListProcedures(Arr(I))
    Range("A" & Er) = Arr(I)
    Range("B" & Er).Resize(UBound(dArr) + 1) = WorksheetFunction.Transpose(dArr)
Next I
End Sub

Tại sao bạn cần "On error resume next"? Nếu bỏ dòng code này thì sao? Ý tôi muốn cách xử lý đến nơi đến chốn chứ không phải có kết quả bằng mọi giá

HaCoChu · 5/10/18

ndu96081631 đã viết:
Tại sao bạn cần "On error resume next"? Nếu bỏ dòng code này thì sao? Ý tôi muốn cách xử lý đến nơi đến chốn chứ không phải có kết quả bằng mọi giá

Cái đó em dùng để bỏ qua lỗi khi mảng dArr là rỗng Thầy ạ. Đúng ra phải làm thêm một bước là kiểm tra mảng kết quả có dữ liệu thì gán mới xuống bảng tính. Em sửa lại như thế này ạ

Mã:

Sub LietkeFuncAndsub()
    Dim Arr, dArr, i As Long, Er As Long
    Arr = ListModules()
    For i = LBound(Arr) To UBound(Arr)
        dArr = ListProcedures(Arr(i))
        If Not IsArrayEmtpy(dArr) Then
            Er = Range("B" & Rows.Count).End(xlUp).Row + 1
            Range("A" & Er) = Arr(i)
            Range("B" & Er).Resize(UBound(dArr) + 1) = WorksheetFunction.Transpose(dArr)
        End If
    Next i
End Sub
Function IsArrayEmtpy(Mang As Variant) As Boolean
    On Error GoTo Loi
    Dim i As Long
    i = UBound(Mang)
    IsArrayEmtpy = False
    Exit Function
Loi:
    IsArrayEmtpy = True
End Function

ndu96081631 · 5/10/18

HaCoChu đã viết:
Cái đó em dùng để bỏ qua lỗi khi mảng dArr là rỗng Thầy ạ. Đúng ra phải làm thêm một bước là kiểm tra mảng kết quả có dữ liệu thì gán mới xuống bảng tính. Em sửa lại như thế này ạ

Mã:

Sub LietkeFuncAndsub() Dim Arr, dArr, i As Long, Er As Long Arr = ListModules() For i = LBound(Arr) To UBound(Arr) dArr = ListProcedures(Arr(i)) If Not IsArrayEmtpy(dArr) Then Er = Range("B" & Rows.Count).End(xlUp).Row + 1 Range("A" & Er) = Arr(i) Range("B" & Er).Resize(UBound(dArr) + 1) = WorksheetFunThật ra ban ction.Transpose(dArr) End If Next i End Sub Function IsArrayEmtpy(Mang As Variant) As Boolean On Error GoTo Loi Dim i As Long i = UBound(Mang) IsArrayEmtpy = False Exit Function Loi: IsArrayEmtpy = True End Function

Không cần cầu kỳ vậy đâu. Thật ra bạn chỉ cần sửa đoạn cuối của hàm ListProcedures thế này:

Mã:

If I Then ListProcedures = Arr

và code của bạn thêm thế này:

Mã:

If IsArray(dArr) Then
      Range("A" & Er) = Arr(I)
      Range("B" & Er).Resize(UBound(dArr) + 1) = WorksheetFunction.Transpose(dArr)
End If

vậy thôi
Giờ bỏ On error resume next đươc rồi đó

Hiển thị các Sub và Function trong Modul ra ngoài excel

vanaccex

Thành viên tiêu biểu

File đính kèm

HaCoChu

Thành viên mới

be_09

Biên Hòa, Đồng Nai

ndu96081631

Huyền thoại GPE

vanaccex

Thành viên tiêu biểu

zou

Thành viên mới

vanaccex

Thành viên tiêu biểu

zou

Thành viên mới

HaCoChu

Thành viên mới

ndu96081631

Huyền thoại GPE

HaCoChu

Thành viên mới

ndu96081631

Huyền thoại GPE

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

Facebook

Group

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