自动修改Excel VBA [关闭]

Question

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

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

Answer 1

您可以编写VBA程序来自动执行代码更改过程

在工具 - >参考

添加：Microsoft Visual Basic For Applications Extensibility XY

下面是我编写的一些代码，用于将代码添加到ThisWorkbook Module中

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