如何利用VBA读取和写入VBA代码

卵石之美

各位大神们，新萌想通过外部程序读取、写入VBA代码。

使用场景：
1、写入：A表格有一段文本需要写入到B表格的宏程序里，并且B表格可以调用。
2、读取：A表格读取B表格中的宏程序并输出，输出方式不限。

网络上搜索是别的代码，不知道要如何实现，望各位大神们帮帮忙，万分感谢。

卵石之美

顶顶，求大神看到

ericxzhou

卵石之美 发表于 2021-11-4 14:07
顶顶，求大神看到

请上传附件，演示需要的结果。

opiona

1. Sub opiona2() '//每个Sheet中写入代码
   
2.     '--------------要写入的代码----------------------------------------------------
   
3.     strProc = " Private Sub Worksheet_Change(ByVal Target As Range)"
   
4.     strProc = strProc & vbCrLf & "   On Error Resume Next"
   
5.     strProc = strProc & vbCrLf & "   If Target.Column = 3 Then"
   
6.     strProc = strProc & vbCrLf & "         If InStr(Target.Value, " & Chr(34) & " " & Chr(34) & ") > 0 Then"
   
7.    
   
8.     strProc = strProc & vbCrLf & "             MsgBox " & Chr(34) & "表中“AID”列的单元格数据存在空格，将自动给你删除空格" & Chr(34) & ", vbintformatiom, " & Chr(34) & "温馨提示" & Chr(34)
   
9.     strProc = strProc & vbCrLf & "             Target.Value = Replace(Target.Value, " & Chr(34) & " " & Chr(34) & ", " & Chr(34) & "" & Chr(34) & ")"
   
10.     strProc = strProc & vbCrLf & "         End If"
    
11.     strProc = strProc & vbCrLf & "    End If"
    
12.     strProc = strProc & vbCrLf & "end sub "
    
13.     '-----------查找这个名称-------------------------------------
    
14.     For Each mk In ThisWorkbook.VBProject.VBComponents
    
15.         If InStr(mk.Name, "Sheet") > 0 Then
    
16.             '  MsgBox mk.Name
    
17.             'mk.VBProject.VBComponents.Remove mk '//删除这个模块
    
18.             If mk.Name <> "ThisWorkbook" Or mk.Name <> "Sheet1" Then
    
19.                 mk.CodeModule.AddFromString strProc '//插入代码
    
20.             End If
    
21.         End If
    
22.     Next
    
23. End Sub
    
24. 
    
25. Sub DelCodes()  '//删除全部代码
    
26.     For Each mk In ThisWorkbook.VBProject.VBComponents
    
27.         If InStr(mk.Name, "Sheet") > 0 Then
    
28.             '  MsgBox mk.Name
    
29.             'mk.VBProject.VBComponents.Remove mk '//删除这个模块
    
30.             If mk.Name <> "ThisWorkbook" Or mk.Name <> "Sheet1" Then
    
31.                 With mk.CodeModule
    
32.                     .DeleteLines 1, .CountOfLines  '//删除全部代码
    
33.                 End With
    
34.                
    
35.             End If
    
36.         End If
    
37.     Next
    
38. End Sub

复制代码

卵石之美

opiona 发表于 2021-11-4 15:25

谢谢大神，太厉害了