excel - 自动修改 Excel VBA

Question

对于客户端，我需要修改数百个 Excel 电子表格中包含的 VBA 代码——一些 dll 调用需要替换为对另一个库的调用。

有没有办法编写一个程序（VB、.NET、java...）来打开电子表格，查看包含的 VBA，应用必要的修改并保存它？

Answer 1

您可以编写一个 VBA 程序来自动化代码更改过程

在工具-->参考

添加：Microsoft Visual Basic For Applications Extensibility XY

下面是我编写的一些代码，用于将代码添加到 ThisWorkbook 模块中的关键功能是

插入线

线条

删除线

外部参考：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