' Copyright (C) 2003 Florian Weimer
' All rights reservered.

Option Explicit

Function ListFiles() As Collection
    Dim files As New Collection
    Dim cbar As CommandBar
    Dim c As CommandBarControl
    Dim File As String

    For Each cbar In Application.CommandBars
        For Each c In cbar.Controls
            If c.Type = msoControlButton Then
                If c.OnAction <> "" Then
                    File = OnlyFileName(c.OnAction)
                    On Error Resume Next
                    files.Add File, File
                    On Error GoTo 0
                End If
            End If
        Next
    Next
        
    Set ListFiles = files
End Function

Function OnlyFileName(Ref As String) As String
    Dim j As Integer
    Dim File As String
    
    For j = Len(Ref) To 1 Step -1
        If Mid(Ref, j, 1) = "!" Then
            File = Mid(Ref, 1, j - 1)
            If Mid(File, 1, 1) = "'" Then
                File = Mid(File, 2)
            End If
            If Mid(File, Len(File)) = "'" Then
                File = Mid(File, 1, Len(File) - 1)
            End If
            OnlyFileName = File
            Exit Function
        End If
    Next
    
    OnlyFileName = Ref
End Function

Function ListBogusFiles() As Collection
    Dim files As Collection
    Dim Bogus As New Collection
    Dim j As Integer
    Dim File As String
    Dim filetest As String
        
    Set files = ListFiles()
    
    For j = 1 To files.count
        File = files(j)
        
        filetest = ""
        On Error Resume Next
        filetest = Dir(File)
        On Error GoTo 0
        
        If filetest = "" Then
            Bogus.Add (File)
        End If
    Next
    
    Set ListBogusFiles = Bogus
End Function

Function FirstBogusFile() As String
    Dim files As Collection
    Set files = ListBogusFiles()
    
    If files.count > 0 Then
        FirstBogusFile = files(1)
    Else
        FirstBogusFile = ""
    End If
End Function

Function MatchCount(Pattern As String) As Integer
    Dim count As Integer
    Dim cbar As CommandBar
    Dim c As CommandBarControl
    
    For Each cbar In Application.CommandBars
        For Each c In cbar.Controls
            If c.Type = msoControlButton Then
                If c.OnAction <> "" Then
                    If InStr(c.OnAction, Pattern) > 0 Then
                        count = count + 1
                    End If
                End If
            End If
        Next
    Next
        
    MatchCount = count
End Function

Function FirstMatch(Pattern As String) As String
    Dim cbar As CommandBar
    Dim c As CommandBarControl
    
    For Each cbar In Application.CommandBars
        For Each c In cbar.Controls
            If c.Type = msoControlButton Then
                If c.OnAction <> "" Then
                    If InStr(c.OnAction, Pattern) > 0 Then
                        FirstMatch = c.OnAction + ""
                        Exit Function
                    End If
                End If
            End If
        Next
    Next
        
    FirstMatch = ""
End Function

Function FirstReplacement(Source As String, Target As String) As String
    Dim cbar As CommandBar
    Dim c As CommandBarControl
    
    For Each cbar In Application.CommandBars
        For Each c In cbar.Controls
            If c.Type = msoControlButton Then
                If c.OnAction <> "" Then
                    If InStr(c.OnAction, Source) > 0 Then
                        FirstReplacement = TranslateFile(c.OnAction, Source, Target)
                        Exit Function
                    End If
                End If
            End If
        Next
    Next
        
    FirstReplacement = ""
End Function

Function TranslateFile(ByVal File As String, ByVal Source As String, ByVal Target As String) As String
    Dim Pos As Integer
    
    Pos = InStr(File, Source)
    If Pos > 0 Then
        TranslateFile = Mid(File, 1, Pos - 1) + Target + Mid(File, Pos + Len(Source))
    Else
        TranslateFile = File
    End If
End Function
Sub TranslateAll(Source, Target)
    Dim cbar As CommandBar
    Dim c As CommandBarControl
    
    For Each cbar In Application.CommandBars
        For Each c In cbar.Controls
            If c.Type = msoControlButton Then
                If c.OnAction <> "" Then
                    If InStr(c.OnAction, Source) > 0 Then
                        c.OnAction = TranslateFile(c.OnAction, Source, Target)
                    End If
                End If
            End If
        Next
    Next
End Sub

Sub DoTranslate()
    Dim Source As String
    Dim Target As String
    Dim cell As Object
    
    Source = ActiveSheet.Range("Source").Value
    Target = ActiveSheet.Range("Target").Value
    
    TranslateAll Source, Target
    
    ' Force recomputation
    
    For Each cell In ActiveSheet.Range("Recalc")
        cell.Formula = cell.Formula
    Next
End Sub