'変数名を置換するマクロ(Excel5.0/95専用)

Option Explicit
Option Compare Binary

Public Sub MyVarReplace()
    Const sAppTitle As String = "変数名の置換"
    Const sTmpFile1 As String = "varpl1.tmp"
    Const sTmpFile2 As String = "varpl2.tmp"
    Dim oModule As Object
    Dim sWhat As String
    Dim sReplacement As String
    Dim iRet As Long

    If TypeName(ActiveSheet) <> "Module" Then
        MsgBox "モジュールシートをアクティブにしてください。", _
            vbExclamation, sAppTitle
        Exit Sub
    End If

    sWhat = ""
    sWhat = InputBox("検索する変数名を入力してください。" & _
        Chr$(10) & "大文字小文字は区別されます。", sAppTitle, sWhat)
    If sWhat = "" Then Exit Sub
    sReplacement = InputBox("置換後の変数名を入力してください。" & _
        Chr$(10) & "大文字小文字は区別されます。", sAppTitle, sWhat)
    If sReplacement = "" Then Exit Sub

    If MsgBox("変数名を置換します。" & Chr$(10) & Chr$(10) & _
            sWhat & "  ->  " & sReplacement, _
            vbExclamation Or vbOKCancel, sAppTitle) <> vbOK Then
        Exit Sub
    End If

    If (Dir$(sTmpFile1) <> "") Or (Dir$(sTmpFile2) <> "") Then
        If MsgBox("一時ファイルを上書きしますか?" & Chr$(10) & _
                Chr$(10) & sTmpFile1 & Chr$(10) & sTmpFile2, _
                vbExclamation Or vbOKCancel, sAppTitle) <> vbOK Then
            Exit Sub
        End If
    End If

    Application.DisplayAlerts = False
    ActiveSheet.SaveAs sTmpFile1, xlText
    Application.DisplayAlerts = True

    iRet = VarReplace( _
        sWhat:=sWhat, _
        sReplacement:=sReplacement, _
        sFile_Input:=sTmpFile1, _
        sFile_Output:=sTmpFile2)
    If iRet > 0 Then
        Set oModule = ActiveWorkbook.Modules.Add
        oModule.InsertFile sTmpFile2
        MsgBox CStr(iRet) & " 個、置換しました。" & Chr$(10) & Chr$(10) & _
            sWhat & "  ->  " & sReplacement, vbInformation, sAppTitle
    ElseIf iRet = 0 Then
        MsgBox "変数名は見つかりませんでした。" & Chr$(10) & Chr$(10) & _
            sWhat & "  ->  " & sReplacement, vbInformation, sAppTitle
    Else
        MsgBox "エラーが発生しました。" & Chr$(10) & Chr$(10) & _
            sWhat & "  ->  " & sReplacement, vbExclamation, sAppTitle
    End If
End Sub

Private Function VarReplace( _
    sWhat As String, _
    sReplacement As String, _
    sFile_Input As String, _
    sFile_Output As String) As Long

    Const sDQuote As String = """"
    Const sSQuote As String = "'"

    Dim hFile_Input As Integer
    Dim hFile_Output As Integer
    Dim bOpen  As Boolean
    Dim bComment As Boolean
    Dim sLine As String
    Dim sRet As String
    Dim sLeftChar As String
    Dim sRightChar As String
    Dim iStart As Long
    Dim iNext As Long
    Dim iLen As Long
    Dim iCount As Long
    Dim i As Long

    On Error GoTo ErrorHandler

    iLen = Len(sWhat)
    iCount = 0

    hFile_Input = FreeFile()
    Open sFile_Input For Input As hFile_Input
    hFile_Output = FreeFile()
    Open sFile_Output For Output As hFile_Output

    Do Until EOF(hFile_Input)

        '1行入力します。
        Line Input #hFile_Input, sLine

        '文字列を検索します。
        iStart = 1
        iNext = InStr(iStart, sLine, sWhat, 0)

        If iNext = 0 Then
            Print #hFile_Output, sLine
        Else
            sRet = ""
            bOpen = False
            bComment = False

            '文字列の検索と置換を繰り返します。
            Do
                '文字列の左部分の"の数と'の有無を調べます。
                i = iStart
                Do While i < iNext
                    Select Case Mid$(sLine, i, 1)

                        '"の場合
                        Case sDQuote

                            If Mid$(sLine, i + 1, 1) = sDQuote Then

                                '次の1文字も"の場合は読み飛ばします。
                                i = i + 1
                            Else

                                '文字列定数の開始フラグを反転します。
                                bOpen = Not bOpen
                            End If

                        ''の場合
                        Case sSQuote
                            If Not bOpen Then

                                '文字列定数でなければコメントです。
                                bComment = True
                                Exit Do
                            End If
                    End Select
                    i = i + 1
                Loop

                'コメントの場合は残りの部分をそのまま出力します。
                If bComment Then
                    sRet = sRet & Mid$(sLine, iStart)
                    Print #hFile_Output, sRet
                    Exit Do
                End If

                If bOpen Then

                    '文字列定数の場合はそのまま出力文字列に追加します。
                    sRet = sRet & Mid$(sLine, iStart, iNext + iLen - iStart)
                Else

                    '見つかった文字列の左1文字を取得します。
                    If iNext = 1 Then
                        sLeftChar = ""
                    Else
                        sLeftChar = Mid$(sLine, iNext - 1, 1)
                    End If

                    '見つかった文字列の右1文字を取得します。
                    sRightChar = Mid$(sLine, iNext + iLen, 1)

                    '前後の1文字が英数字、"_"、全角文字、型宣言文字であれば
                    '置換し、出力文字列に追加します。
                    If (LenB(sLeftChar) <> 2) And (LenB(sRightChar) <> 2) And _
                            ((sLeftChar = "") Or (Not (sLeftChar Like "[0-9A-Z_a-z]"))) And _
                            ((sRightChar = "") Or (Not (sRightChar Like "[#$%&0-9@A-Z_a-z!]"))) Then
                        sRet = sRet & Mid$(sLine, iStart, iNext - iStart) & sReplacement
                        iCount = iCount + 1
                    Else
                        sRet = sRet & Mid$(sLine, iStart, iNext + iLen - iStart)
                    End If
                End If

                '次を検索します。
                iStart = iNext + iLen
                iNext = InStr(iStart, sLine, sWhat, 0)

            '検索文字列が見つからなければループを抜けます。
            Loop Until iNext = 0

            '最後の文字列部分を出力文字列に追加し、ファイルへ出力します。
            sRet = sRet & Mid$(sLine, iStart)
            Print #hFile_Output, sRet
        End If
    Loop
    Close #hFile_Input, #hFile_Output
    VarReplace = iCount
    Exit Function

ErrorHandler:
    If hFile_Input <> 0 Then Close #hFile_Input
    If hFile_Output <> 0 Then Close #hFile_Output
    VarReplace = -1
    Exit Function
End Function