Translate programs

To add a support multilanguage to your applications


After several attempts here is a rather practical method to translate its programs.
The following module registers(records) in a file text of extention .LNG the proprietes CAPTION and TOOLTIPTEXT of all the objects of a sheet by using a buckle For each Obj in Form
The file generated by the function(office) SaveAllName will contain so for example:
After translation of left parts procedure LoadAllName is going to change all this wording by using a temporary collection containing translations
By adding this module to a program all the interface can be translated very quickly.

The other sentences which appear in a program can be also translated according to the same principle.
Without in that case it is necessary to fill(perform) a collection translation containing messages:
Private Sub Form_Load()
    With Translation
        .Add "Bonjour comment ca va aujourd'hui", "Bonjour comment ca va aujourd'hui"
        .Add "Etes vous sur", "Etes vous sur"
        .Add "Si vous voulez traduire ce programme dans un autre langage,", "Si vous voulez traduire ce programme dans un autre langage,"
        .Add "ouvrez un fichier .LNG (du répertoire de l'application) avec un editeur de texte,", "ouvrez un fichier .LNG (du répertoire de l'application) avec un editeur de texte,"
        .Add "traduisez les lignes du fichier et enregistrez le sous un autre nom.", "traduisez les lignes du fichier et enregistrez le sous un autre nom."
        .Add "La version francaise est de fredjust@hotmail.com", "La version francaise est de fredjust@hotmail.com"
    End With
End Sub
This collection will be also protected in the file.
In the program the posting of a chaine of characters will make through the function(office) TRANSLATE:
Public Function Translate(sentence As String) As String
    On Error Resume Next
    Translate = Translation(sentence)
    If Err.Number <> 0 Then Translate = sentence
Function
If translation exists in the collection she(it) will be posted(shown) in the place otherwise original sentence will be posted(shown).

Source suit of the module translate:

( Sources converts in 6 colours with my VB TO HTML program) 


'===============================================================================
'   send comments to
'   fredjust@hotmail.com
'   http://fred.just.free.fr/
'===============================================================================


' Add a "Microsoft scripting runtime" REFERENCE only on VB6
Public FSO As New FileSystemObject
Public TextStream As TextStream

Dim Tempo As String
Dim Obj As Control
Dim phrase
Dim CaptionCollection As Collection
Dim ObjIndex As Long
Public Translation As New Collection

'==================================================================================
'   Save all caption, tooltiptext, and Sentences of the Translation collection
'==================================================================================
Public Sub SaveAllName(ByVal aForm As Form, ByVal FileName As String)


    On Error Resume Next

    ' Create the text file
    Set TextStream = FSO.CreateTextFile(App.Path & "\" & FileName, True)

    ' write produc name
    TextStream.WriteLine "[" & App.Title & "] don't translate this line and the name before '='"
    ' write the caption of form
    TextStream.WriteLine aForm.Name & ".Caption=" & aForm.Caption

    For Each Obj In aForm

        Tempo = ""
        Err.Clear
        ObjIndex = Obj.Index

        
        If Err.Number <> 0 Then ' if the object is not indexed
          Tempo = Obj.Caption

            If Tempo <> "" Then
            ' write Caption of the object
                TextStream.WriteLine Obj.Name & ".Caption=" & Tempo
            End If

            Tempo = ""
            Tempo = Obj.ToolTipText

            If Tempo <> "" Then
            ' write ToolTipText of the object
                TextStream.WriteLine Obj.Name & ".ToolTipText=" & Tempo
            End If

        Else        ' if the object is indexed

            Tempo = Obj.Caption

            If Tempo <> "" Then
            ' write Caption of the object
                TextStream.WriteLine Obj.Name & "(" & Obj.Index & ").Caption=" & Tempo
            End If

            Tempo = ""
            Tempo = Obj.ToolTipText

            If Tempo <> "" Then
            ' write ToolTipText of the object
                TextStream.WriteLine Obj.Name & "(" & Obj.Index & ").ToolTipText=" & Tempo
            End If

        End If

    Next

    ' End of this section IMPORTANT it's use in the LOAD function
    TextStream.WriteLine "[END CAPTION] - don't translate this line"

    ' write all sentence
    For Each phrase In Translation
        TextStream.WriteLine phrase & "=" & Translation(phrase)
    Next

    TextStream.Close
End Sub

'==================================================================================
'   Load and change Caption and toolTipText
'==================================================================================
Public Sub LoadAllName(aForm As Form, FileName As String)
    Dim BeginName  As Long

    On Error Resume Next

    ' open the text file
    Set TextStream = FSO.OpenTextFile(App.Path & "\" & FileName, ForReading)
    
    'clear the collection
    Set CaptionCollection = New Collection

    Tempo = TextStream.ReadLine
    
    ' is the file is for this application ?
    If InStr(1, Tempo, App.Title) = 0 Then
        MsgBox "The file is invalid !"
        Set CaptionCollection = Nothing
        TextStream.Close
        Exit Sub
    End If

    ' caption form on the 2° line
    Tempo = TextStream.ReadLine
    BeginName = InStr(1, Tempo, "=")
    aForm.Caption = Mid(Tempo, BeginName + 1)

    Tempo = TextStream.ReadLine

    ' read all caption and tooltiptext which are in the file
    While InStr(1, Tempo, "[END CAPTION]") = 0 And Err.Number = 0
        BeginName = InStr(1, Tempo, "=")
        CaptionCollection.Add Mid(Tempo, BeginName + 1), Mid(Tempo, 1, BeginName - 1)
        Tempo = TextStream.ReadLine
    Wend

    ' no error (we found [END CAPTION] in the file)
    If Err.Number = 0 Then
    
        For Each Obj In aForm

            Err.Clear
            ObjIndex = Obj.Index

            'if the objet is indexed
            If Err.Number = 0 Then
                ' change caption of object
                Obj.Caption = CaptionCollection(Obj.Name & "(" & Obj.Index & ").Caption")
                ' change tooltiptext of object
                Obj.ToolTipText = CaptionCollection(Obj.Name & "(" & Obj.Index & ").tooltiptext")
            Else
                ' change caption of object
                Obj.Caption = CaptionCollection(Obj.Name & ".Caption")
                ' change tooltiptext of object
                Obj.ToolTipText = CaptionCollection(Obj.Name & ".tooltiptext")
            End If

        Next

        ' clear the translation collection
        Set Translation = New Collection
        
        Do
            Tempo = TextStream.ReadLine
            BeginName = InStr(1, Tempo, "=")
            Translation.Add Mid(Tempo, BeginName + 1), Mid(Tempo, 1, BeginName - 1)
        Loop Until TextStream.AtEndOfStream
        
    Else
        MsgBox "The file is invalid !"
    End If

    TextStream.Close

    Set CaptionCollection = Nothing
End Sub

'===============================================================================
'   return the translation of a sentence
'   if it doesn't exist the sentence wasn't translate
'===============================================================================
Public Function Translate(sentence As String) As String
    On Error Resume Next
    Translate = Translation(sentence)
    If Err.Number <> 0 Then Translate = sentence
Function