自动化Excel VBA的修改
对于客户端,我需要修改包含在数百个Excel电子表格中的VBA代码 – 某些dll调用需要被另一个库调用所取代。
有没有办法编写一个程序(VB,.NET,Java等),打开电子表格,查看包含的VBA,应用必要的修改并保存它?
您可以编写一个VBA程序来自动执行代码更改过程
在工具 – >参考
添加:Microsoft Visual Basic对于应用程序扩展性XY
下面是我写的代码添加到ThisWorkbook模块的一些代码关键function是
InsertLines
行
DeleteLines
外部参考: http ://www.vbaexpress.com/kb/getarticle.php?kb_id= 250
Dim wsName As String Dim row As Long Dim col As Long Dim VBCM As CodeModule Dim VBP As VBProject Dim VBC As VBComponent Dim line As String Dim insertStr As String Dim clearCode As Boolean Dim line2 As String Dim i As Long, j As Long clearCode = False If formula = "" Then Exit Sub End If If formula = "DEL" Then clearCode = True End If On Error GoTo Err: If Selection.count = 1 Then wsName = ActiveSheet.Name row = Selection.row col = Selection.column Set VBP = Application.VBE.ActiveVBProject For Each VBC In VBP.VBComponents If VBC.Name = "ThisWorkbook" Then Set VBCM = VBC.CodeModule Start = False endLine = False For i = 1 To VBCM.CountOfLines line = VBCM.Lines(i, 1) line = Trim(line) 'remove the leading and trailing spaces If line = "Private Sub Workbook_Open()" Then Start = True End If If Start Then If clearCode Then For j = i + 1 To VBCM.CountOfLines line = VBCM.Lines(j, 1) line = Trim(line) 'remove the leading and trailing spaces If line = "With Worksheets(""" & wsName & """)" Then line2 = VBCM.Lines(j + 2, 1) line2 = Trim(line2) If line2 = "height = .Cells(" & row & ", " & col & ").End(xlDown).row" Then VBCM.DeleteLines j, 8 MsgBox "Delete Code Done" Exit Sub End If End If Next j End If If line = "End Sub" Then endLine = True Exit For End If End If Next i Worksheets(wsName).Cells(row, col).formula = formula formula = Replace(formula, """", """""") 'replace the single doublequote into double doublequotes insertStr = "With Worksheets(""" & wsName & """)" insertStr = insertStr & vbCrLf & " .Activate" insertStr = insertStr & vbCrLf & " height = .Cells(" & row & ", " & col & ").End(xldown).row" insertStr = insertStr & vbCrLf & " If height > row Then" insertStr = insertStr & vbCrLf & " .Range(.Cells(" & row & "," & col & "), .Cells(height," & col & ")).ClearContents" insertStr = insertStr & vbCrLf & " End If" insertStr = insertStr & vbCrLf & " .Cells(" & row & "," & col & ").formula = """ & formula & """" insertStr = insertStr & vbCrLf & "End With" VBCM.InsertLines i - 1, insertStr 'Debug.Print "FOUND" End If Next VBC End If