[已解决]提取每个宏

xdwy81129

我的一个excel里面有很多模块，每个模块里面有许多的宏

希望做到每个宏的内容，能存放到表1的每一列里，即表1的每一列为一个宏的内容，注：宏的每一句话独立在没一个单元格内。

另：希望在每一列的第一行，列示处该宏所处的模块


模式如图：

最佳答案

月排行榜 / 总排行榜

Dj_soo

2010-12-31 04:14

先要引用 MICROSOFT VISUAL  BASIC FOR APPLICATION  EXTENSIBLITY

1. 
   
2. 
   
3. Sub Test()
   
4.     Dim Mdl As VBComponent
   
5.     Dim Line As Long
   
6.     Dim i As Long
   
7.     Dim Col As Integer
   
8.     Dim SubName As String
   
9.     Dim arr As Variant
   
10.     For Each Mdl In ThisWorkbook.VBProject.VBComponents
    
11.         With Mdl.CodeModule
    
12.             For i = 1 To .CountOfLines
    
13.                 SubName = .ProcOfLine(i, vbext_pk_Proc)
    
14.                 If SubName <> "" Then
    
15.                     Col = Col + 1
    
16.                     Line = .ProcCountLines(SubName, vbext_pk_Proc)
    
17.                     arr = Split(.Lines(i, Line), vbCrLf)
    
18.                     arr(0) = Mdl.Name
    
19.                     Cells(1, Col).Resize(Line) = Application.Transpose(arr)
    
20.                     i = i + .ProcCountLines(SubName, vbext_pk_Proc) - 1
    
21.                 End If
    
22.             Next i
    
23.         End With
    
24.     Next
    
25.     Columns.AutoFit
    
26. End Sub

复制代码

跳转到最佳答案楼层

raulerini

额。。。。明确的说，这个我不会，我只是来留个记号，看有没会的。加个关注。{:08:}

chury11

我只是来留个记号

Dj_soo

先要引用 MICROSOFT VISUAL  BASIC FOR APPLICATION  EXTENSIBLITY

1. 
   
2. 
   
3. Sub Test()
   
4.     Dim Mdl As VBComponent
   
5.     Dim Line As Long
   
6.     Dim i As Long
   
7.     Dim Col As Integer
   
8.     Dim SubName As String
   
9.     Dim arr As Variant
   
10.     For Each Mdl In ThisWorkbook.VBProject.VBComponents
    
11.         With Mdl.CodeModule
    
12.             For i = 1 To .CountOfLines
    
13.                 SubName = .ProcOfLine(i, vbext_pk_Proc)
    
14.                 If SubName <> "" Then
    
15.                     Col = Col + 1
    
16.                     Line = .ProcCountLines(SubName, vbext_pk_Proc)
    
17.                     arr = Split(.Lines(i, Line), vbCrLf)
    
18.                     arr(0) = Mdl.Name
    
19.                     Cells(1, Col).Resize(Line) = Application.Transpose(arr)
    
20.                     i = i + .ProcCountLines(SubName, vbext_pk_Proc) - 1
    
21.                 End If
    
22.             Next i
    
23.         End With
    
24.     Next
    
25.     Columns.AutoFit
    
26. End Sub

复制代码

Dj_soo

上面的代码在两个过程直接必须有至少一个空行.否则会出错.

liuguansky

学习下。:D

xdwy81129

Dj_soo 发表于 2010-12-31 10:25
先要引用 MICROSOFT VISUAL  BASIC FOR APPLICATION  EXTENSIBLITY

我复制代码到我的工作薄，运行提示错误，请求在指教

Dj_soo

先要引用 MICROSOFT VISUAL  BASIC FOR APPLICATION  EXTENSIBLITY

xdwy81129

Dj_soo 发表于 2010-12-31 11:45
先要引用 MICROSOFT VISUAL  BASIC FOR APPLICATION  EXTENSIBLITY

看不懂是什么意思，可下载的工作薄可以运行讲师写的宏，把代码复制到我的工作薄就提示如上错误

Dj_soo

另外我代码的缺陷你可以自己尝试修改一下,看看如果过程之间不带空行应该怎么改.
我就不改了,给你自己练习吧.