0

クライアントの場合、何百ものExcelスプレッドシートに含まれているVBAコードを変更する必要があります。一部のdll呼び出しは、別のライブラリへの呼び出しに置き換える必要があります。

スプレッドシートを開き、含まれているVBAを調べ、必要な変更を適用して保存するプログラム(VB、.NET、java ...)を作成する方法はありますか?

4

1 に答える 1

3

コード変更プロセスを自動化する VBA プログラムを作成できます。

ツール内 --> リファレンス

追加: Microsoft Visual Basic For Applications Extensibility XY

以下は、ThisWorkbook モジュールにコードを追加するために私が書いたコードです。主な機能は次のとおりです。

InsertLines

ライン

行の削除

外部参照: 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
于 2012-12-17T10:08:43.627 に答える