PDA

Vollständige Version anzeigen : MultiLanguage via INI-Datei (auch in bestehende Projekte)


Butzel
02.03.2006, 19:47
Hi,

habe zwar nicht viel mit den Office-Krams am Hut, aber für einen Kameraden habe ich in ein bestehendes ACCESS Project nachträglich MULTI-Language Support eingebaut. Damit dann nicht jeder das Rad neu erfinden muss, poste ich meinen - zugegeben nicht sehr sauberen - Code hier zur freien Verfügung.

btw. da es reiner VBa-Code ist, müsste es bis auf die Erstellen-Funktion auch in VB selbst sowie EXCEL+WORD klappen

Wäre nett, wenn ich ein wenig feedback via PN bekommen könnte.


Attribute VB_Name = "mdlMultiLanguage"
'*********************************************************'
'* *'
'* * * * * * * * * * * * * * *'
'* *'
'* MultilanguageSupport für bestehende ACCESS-Projecte *'
'* *'
'* Autor: Butzel { www.butzel.info } *'
'* Version: 1.2006.03.02.1854 *'
'* Hinweis: vor der Einbindung ist ein BackUp *'
'* zu erstellen, keine Haftung für Schäden *'
'* jeglicher Art *'
'* *'
'* * * * * * * * * * * * * * *'
'* *'
'*********************************************************'
'Option Compare Database
Public ML_SPRACHDATEI As String
Public Const ML_ZEILENSCHALTUNG = "\n" 'Zeilenschaltung [Enter]
Public Const ML_KLAMMER_AUF = "\(" 'geschweifte Klammer auf [{]
Public Const ML_KLAMMER_ZU = "\)" 'geschweifte Klammer zu [}]
Public Const ML_GLEICH = "\i" 'Gleich-Zeichen [=]
Public Const ML_SEMIKOLON = "\," 'Semikolon [;]
Public Const ML_TABULATOR = "\t" 'Tabulator [ ]
'** BACKSLASH-Schrägstrich = "\\" 'BackSlash [\]
'
'
'* * * * H I N W E I S E & K U R Z A N L E I T U N G * * * *
' :: Einbindung
'
' o Formulare
' in jedem Formular (auch bei Unterformularen), welche MultiLanguage-Support
' unterstützen soll, muss wie im folgendem Beispiel der multiLanguage-Aufruf
' im LOAD-Event eingefügt werden:
'
' ''''''''' Private Sub Form_Load()
' ''''''''' '...
' ''''''''' '...
' ''''''''' multiLanguage Me, ML_SPRACHDATEI
' ''''''''' '...
' ''''''''' '...
' ''''''''' '...
' ''''''''' End Sub
'
' o die String-Variable ML_SPRACHDATEI enthält dabei die Pfad- und Dateiangabe
' wo sich die zu verwendene Sprachdatei befindet:
' z.B.
'
' ''''''''' ML_SPRACHDATEI = Application.CurrentProject.Path + "\lang.ini"
'
' o Zeichenketten
' hier übersetzt die Funktion multiLanguageString(sText,sDateiNameMitPfad)
' den zuübersetzenden Text. Sofern er in der Sprachdatei gefunden wird
'
' :: Hinweise zur SprachDatei
'
' o die Sprachdatei enthält für jedes unterstütze Formular einen Eintrag nach
' folgendem Beispiel:
'
''' form_name{
''' me.caption=Formular Beschriftung;
''' objectname.caption=Beschriftung des Objects;
''' objectname.tooltip=ToolTip-Text des Objects;
''' cmdexit.caption=Schliessen;
''' cmdexit.tooltip=Schliesst das aktuelle Formular;
''' lbltest.caption=Mein Test Formular\n2.Zeile;
''' lbltest.tooltip=;
''' }
'''
''' !strings{
''' hallo welt=Hallo Welt;
''' wirklich\nlöschen?=Möchten Sie wirklich löschen??\n[JA]-[NEIN];
''' }
'''
'
' o Syntax:
' Nach dem Namen des Formulares sind in geschweiften Klammer die zugehörigen
' Objekte aufgelistet.Die Namen der Objekte (und Formulare) sowie die
' Eigenschaftgen sind in Kleinbuchstaben einzutragen. Zwischen dem [=]-Zeichen
' und dem [;]-Semikolon befindet sich der Text für Beschriftung und ToolTip,
' welcher freimodifiziert werden kann.
' Caption bezeichnet dabei die Beschriftung
' und ToolTip den Steuerelement-Tip
' me.caption stellt die Überschrift des Formulares dar...
'
' o Fehler in der Sprach-Datei
' Fehlen in der Sprach-Datei Objekte (oder FormularNamen) bzw. sind diese falsch
' geschrieben, so werden diese nicht angepasst. Sind Objekte zuviel aufgelistet
' so werden diese ignoriert.
' Bei beiden Fehlern wird keine Fehlerausgabe produziert.
'
' o Weglassen des Beschriftung- bzw. ToolTip-Textes (z.B. objekt.tooltip=;)
' dies hat zur folge das die Beschriftung bzw. ToolTip leer bleibt
' (im Beispiel hat das Objekt keinen Steuerelement-Tip)
'
' o Sonderzeichen:
' (alle ASCII-Zeichen welche kleiner als 29(dezimal) werden ignoriert.)
'
' [{]-[}]-[=]-[;]-[\] und Sonderzeichen-Darstellung in der INI:
'
' \n = Zeilenschaltung [Enter]
' \( = geschweifte Klammer auf [{]
' \) = geschweifte Klammer zu [}]
' \i = Gleich-Zeichen [=]
' \, = Semikolon [;]
' \t = Tabulator [ ]
' \\ = Backslash [\]
' Dies kann durch Änderung der entsprechenden Konstanten angepasst werden,
' jedoch ist das [\]-Zeichen als erstes dieser Darstellungszeichen und
' eine Länge von 2-stellen festgelegt!
'
' o unterstützte Objekte:
' in dieser Version werden folgende Objekttypen unterstützt:
' 100 = Label (Bezeichnungsfeld)
' 104 = CommandButton (Befehlschaltfläche)
' 122 = OptionCommand (Umschaltfläche)
' 124 = TabStrip (Registerkarten)
'
' :: Automatisches erstellen einer Sprach-Datei
'
' o multiLanguageErstelleINI c:\lang.ini
' wenn sich dieses Modul in Ihrem Projekt befindet, die Funktion
' multiLanguageErstelleINI(sDateiNameMitPfad As String) aufrufen.
' sDateiNameMitPfad enthält den Pfad- u. Dateinamen der Speicherortes.
' (ist die angegebene Datei vorhanden, wird sie überschrieben!).
'
' o Funktionsweise
' die Funktion versucht alle Fenster zuöffnen und schreibt dann bei jedem
' geöffneten Fenster die unterstützten Objekte in die angegebene Datei mit
' aktuellen zustand der Beschriftung. So wird eine aktuelle Sprach-Datei zu
' derzeit verwendeten Sprache hergestellt.
' Nach Durchlauf dieser Funktion werden Sie über den Erfolg informiert.
' Schliessen Sie danach die ACCESS ohne zu speichern.
'
'((HINWEIS zur multiLanguageErstelleINI: ))
'(( BETA-Funktion: kein Support, keine Funktionsgarantie))
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' unabhängige Funktionen dieses Modules:''''''''''''''''''''''''''''
'******************************************************************'
' Zwischen( sQuelle, sBeginnString, sEndeString) as String ' '
' '
' Gibt aus der Zeichenkette sQuelle, den Bereich zwischen '
' sBeginnStr und sEndeStr zurück '
' ---> benötigt imString <--- '
' '
'******************************************************************'
' ZwischenX(sQuelle, sBeginnString, sEndeString) as String '
' '
' Gibt aus der Zeichenkette sQuelle, den Bereich zwischen '
' sBeginnStr und sEndeStr zurück '
' X-Funktion: '
' um sollte zwischen sBeginn und sEnde weitere sBeginn vorhanden '
' sein so versucht ZwischenX jedes sBeginn mit einem sEnde zu '
' schliessen '
' ---> benötigt imString <--- '
' '
'******************************************************************'
' '
' imString(sSucheIn, sSucheNach) as Long '
' '
' Gibt die Position von sSucheNach in sSucheIn zurück '
' '
' '
'******************************************************************'



Public Function multiLanguageGetEnter(sWert As String) As String
' ersetzt enterschaltungen mit µ
Dim nZaehler As Long
Dim RetVal As String
RetVal = ""
For nZaehler = 1 To Len(sWert)
Select Case Asc(Mid(sWert, nZaehler, 1))
Case 92
RetVal = RetVal + "\\"
Case 13
RetVal = RetVal + ML_ZEILENSCHALTUNG
Case 10
'Teil 2 der Zeilenschaltung
Case 123
RetVal = RetVal + ML_KLAMMER_AUF
Case 125
RetVal = RetVal + ML_KLAMMER_ZU
Case 61
RetVal = RetVal + ML_GLEICH
Case 59
RetVal = RetVal + ML_SEMIKOLON
Case 9
RetVal = RetVal + ML_TABULATOR
Case Else
RetVal = RetVal + Mid(sWert, nZaehler, 1)
End Select
Next nZaehler
multiLanguageGetEnter = RetVal
End Function
Public Function multiLanguageSetEnter(sWert As String) As String
'ersetzt enterschaltungen mit µ
Dim nZaehler As Long
Dim RetVal As String
RetVal = ""
For nZaehler = 1 To Len(sWert)

If Mid(sWert, nZaehler, 1) = "\" Then
Select Case Mid(sWert, nZaehler, 2)
Case ML_ZEILENSCHALTUNG

RetVal = RetVal + Chr(13) + Chr(10)
Case ML_KLAMMER_AUF
RetVal = RetVal + Chr(123)
Case ML_KLAMMER_ZU
RetVal = RetVal + Chr(125)
Case ML_GLEICH
RetVal = RetVal + Chr(61)
Case ML_SEMIKOLON
RetVal = RetVal + Chr(59)
Case ML_TABULATOR
RetVal = RetVal + Chr(9)
Case "\\"
RetVal = RetVal + "\"
Case Else
nZaehler = nZaehler - 1
RetVal = RetVal + Mid(sWert, nZaehler, 1)
End Select
nZaehler = nZaehler + 1
Else
RetVal = RetVal + Mid(sWert, nZaehler, 1)
End If

' If Mid(sWert, nZaehler, Len(ML_ZEILENSCHALTUNG)) = ML_ZEILENSCHALTUNG Then
' RetVal = RetVal + Chr(13) + Chr(10)
' n = n + Len(ML_ZEILENSCHALTUNG) - 1
' Else
' RetVal = RetVal + Mid(sWert, nZaehler, 1)
' End If
Next nZaehler

multiLanguageSetEnter = RetVal
End Function


Public Function ZwischenX(ByVal sQuelle, ByVal sBeginnString, ByVal sEndeString, Optional ByVal iStart As Long = 1) As String
'******************************************************************'
' '
' Gibt aus der Zeichenkette sQuelle, den Bereich zwischen '
' sBeginnStr und sEndeStr zurück '
'X-Funktion: '
' um sollte zwischen sBeginn und sEnde weitere sBeginn vorhanden '
' sein so versucht ZwischenX jedes sBeginn mit einem sEnde zu '
' schliessen '
' '
'******************************************************************'
Dim iBeginn As Long
Dim iEnde As Long
Dim nZaehler As Long
Dim nOffen As Integer
iBeginn = 0
iBeginn = imString(sQuelle, sBeginnString, iStart)
If iBeginn = 0 Then
Zwischen = "": Exit Function
Else
iBeginn = iBeginn + Len(sBeginnString)
End If

iEnde = 0
nOffen = 0
Dim debugvar
For nZaehler = iBeginn To Len(sQuelle)
debugvar = Mid(sQuelle, nZaehler, Len(sBeginnString))
If Mid(sQuelle, nZaehler, Len(sBeginnString)) = sBeginnString Then
nOffen = nOffen + 1
End If
If nOffen = 0 Then
If Mid(sQuelle, nZaehler, Len(sBeginnString)) = sEndeString Then
iEnde = nZaehler
End If
Else
If Mid(sQuelle, nZaehler, Len(sBeginnString)) = sEndeString Then
nOffen = nOffen - 1
End If
End If
Next nZaehler
If sBeginnString = sEndeString Then iEnde = imString(sQuelle, sEndeString, iBeginn)
If iEnde = 0 Then
ZwischenX = Mid(sQuelle, iBeginn)
Else
ZwischenX = Mid(sQuelle, iBeginn, iEnde - iBeginn)
End If
End Function

Public Function Zwischen(ByVal sQuelle, ByVal sBeginnString, ByVal sEndeString, Optional ByVal iStart As Long = 1) As String
'******************************************************************'
' '
' Gibt aus der Zeichenkette sQuelle, den Bereich zwischen '
' sBeginnStr und sEndeStr zurück '
' '
'******************************************************************'
Dim iBeginn As Long
Dim iEnde As Long
iBeginn = 0
iBeginn = imString(sQuelle, sBeginnString, iStart)
If iBeginn = 0 Then
Zwischen = "": Exit Function
Else
iBeginn = iBeginn + Len(sBeginnString)
End If
iEnde = imString(sQuelle, sEndeString, iBeginn)
If iEnde = 0 Then
Zwischen = Mid(sQuelle, iBeginn)
Else
Zwischen = Mid(sQuelle, iBeginn, iEnde - iBeginn)
End If
End Function

Public Function imString(ByVal sSucheIn, ByVal sSucheNach, Optional ByVal iStart As Long = 1) As Long
'******************************************************************'
' '
' wusste gar nicht, das VB die Funktion InStr hat... '
' '
'******************************************************************'
If iStart = 0 Then iStart = 1
imString = InStr(iStart, sSucheIn, sSucheNach)
End Function

Public Sub multiLanguage(oFormular As Form, Optional ByVal sDateiNameMitPfad As String)
'Variablendeklaration
Dim oElement As Object
Dim sEnter As String
Dim RetVal As String
Dim sIniFormular As String
Dim nZaehler As Long
'Variablen initialisierung
Enter = vbCr
sIniFormular = ""


'Sollte die Datei, nicht angegeben werden, so nutze diese:
If sDateiNameMitPfad = "" Then Exit Sub
'sDateiNameMitPfad = Application.CurrentProject.Path + "\lang.ini"
'endif

'Sprachdatei in die Variable siniFile einlesen (beispiel aus der hilfe ;)
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile(sDateiNameMitPfad, 1)
sIniFormular = a.ReadAll
a.Close

'Wenn sie leer ist hats auch keinen sinn
If sIniFormular = "" Then Exit Sub


'Zeichen unter ASCII-Code 29 rausnehmen
RetVal = ""
For nZaehler = 1 To Len(sIniFormular)
If Asc(Mid(sIniFormular, nZaehler , 1)) > 29 Then
RetVal = RetVal + Mid(sIniFormular, nZaehler , 1)
End If
Next nZaehler
sIniFormular = RetVal
RetVal = ""



'zum Formular die Beschriftungen lesen
sIniFormular = Zwischen(sIniFormular, LCase(oFormular.Name) + "{", "}")

'Jedes Element des aktuellen oFormulares durchgehen
For Each oElement In oFormular.Controls
RetVal = multiLanguageLeseINI(sIniFormular, "me", "caption")
If Len(RetVal) > 0 Then
oFormular.Caption = RetVal

End If
'Wenn es ein Element mit Caption und Beschriftung ist, so überschreibe tooltip und caption
If oElement.ControlType = 100 Or oElement.ControlType = 104 Or oElement.ControlType = 122 Or oElement.ControlType = 124 Then

'Beschriftungseigenschaft (Caption)
RetVal = multiLanguageLeseINI(sIniFormular, oElement.Name, "caption")
If Len(RetVal) > 0 Then
oElement.Caption = RetVal
End If

'ToolTipText-Egenschaft (ControlTipText)
RetVal = multiLanguageLeseINI(sIniFormular, oElement.Name, "tooltip")
If Len(RetVal) > 0 Then
oElement.ControlTipText = RetVal
End If

End If

Next oElement
'fix noch das me.refresh und fertig ist der käse ;)
oFormular.Refresh

End Sub

Public Sub multiLanguageErstelleINI(sDateiNameMitPfad As String)
Dim oFormulare As Object
Dim oFormular As Form
Dim oElement As Object
Dim sAktFensterName As String
Dim sEnter As String
Dim RetVal As String
Dim nZaehler As Integer
Dim nZaehler2 As Integer
sAktFensterName = Application.Screen.ActiveForm.Name
sEnter = Chr(13) + Chr(10)
RetVal = "LANGUAGE=Deutsch (Deutschland)" + sEnter + Chr(13) + sEnter

For Each oFormulare In Application.CurrentProject.AllForms
DoCmd.OpenForm oFormulare.Name
' oFormulare.SetFocus
DoCmd.SelectObject acForm, oFormulare.Name
nZaehler = nZaehler + 1
DoEvents
Next

nZaehler2 = nZaehler


DoEvents

For Each oFormular In Application.Forms
nZaehler = nZaehler - 1
DoEvents
RetVal = RetVal + LCase(oFormular.Name) & "{" + sEnter
RetVal = RetVal + "me.caption=" + oFormular.Caption + ";"

For Each oElement In oFormular.Controls
If oElement.ControlType = 100 Or oElement.ControlType = 104 Or oElement.ControlType = 122 Or oElement.ControlType = 124 Then
RetVal = RetVal + LCase(oElement.Name) & ".caption=" & multiLanguageGetEnter(oElement.Caption) & ";" + sEnter
RetVal = RetVal + LCase(oElement.Name) & ".tooltip=" & multiLanguageGetEnter(oElement.ControlTipText) & ";" + sEnter
End If
Next oElement

RetVal = RetVal + "}" + sEnter + sEnter


Next oFormular




'Schreibe ini
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(sDateiNameMitPfad, True)
a.write RetVal
a.Close

MsgBox "Gespeichert unter: " & vbCr & sDateiNameMitPfad & vbCr & _
"Formulare im Projekt: " & nZaehler2 & vbCr & _
"Formulare in INI: " & nZaehler2 - nZaehler & vbCr & _
"=Differenz: " & nZaehler, vbInformation, "Sprach.ini-Referenz wurde erstellt"



End Sub


Public Sub multiLanguageSchreibeINI(sDateiName As String, sFormular As String, sControl As String, sEigenschaft, sBeschriftung)
System.PrivateProfileString(sDateiName, sFormular, sControl & "." & sEigenschaft) = sBeschriftung
End Sub

Public Function multiLanguageLeseINI(sFormular As String, sControl As String, sEigenschaft As String) As String
sEigenschaft = LCase(sEigenschaft)
sControl = LCase(sControl)
Dim RetVal As String
RetVal = ""
Select Case sEigenschaft
Case "caption"
RetVal = multiLanguageSetEnter(Zwischen(sFormular, sControl + ".caption=", ";"))
Case "tooltip"
RetVal = multiLanguageSetEnter(Zwischen(sFormular, sControl + ".tooltip=", ";"))
End Select
multiLanguageLeseINI = RetVal
End Function


Public Function multiLanguageString(ByVal sText As String, sDateiNameMitPfad As String) As String
Dim RetVal As String
RetVal = ""
'Sprachdatei in die Variable siniFile einlesen (beispiel aus der hilfe ;)
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile(ML_SPRACHDATEI, 1)
RetVal = a.ReadAll
a.Close 'dateischliessen
RetVal = Zwischen(RetVal, "!strings{", "}")
RetVal = Zwischen(RetVal, multiLanguageGetEnter(LCase(sText)) + "=", ";")
'Sollte der Begriff nicht gefunden werden, so wird der deutsche genommen
If RetVal = "" Then RetVal = sText
multiLanguageString = multiLanguageSetEnter(RetVal)
End Function

Inti31
04.03.2006, 18:54
Dieses Modul funzt einwandfrei.

Zum besseren Verständnis hier eine Beispiels-DB (siehe Anhang)

Beinhaltet 1 Dummy Tabelle sowie 2 Formulare - incl. der INI-Datei, in der die Übersetzungen drinstehen
(für Formular 1).

Wird die Test-DB gestartet wird überprüft, ob die lang.ini im selben Verzeichnis vorhanden ist - wenn nicht wird die ini-Datei angelegt und Access danach geschlossen.
Ein erneuter Start öffnet dann das Formular 1.

Ist die ini-Datei vorhanden, wird automatisch das Formular 1 gestartet.

Zusätzlich habe ich noch Übersetzungen für Messgeboxes mit aufgenommen :)

Inti31

Butzel
05.03.2006, 14:57
Hi Inti32,

danke, natürlich funktioniert es ;)
Danke für Dein Bsp. Projekt... so ist meine KurzAnleitung auch einfacher zu verstehen...
Ich hoffe Du (& alle anderen Interessierten) können etwas mit diesem Modul anfangen... sollten Fehler, Probleme auftauchen oder verbesserungsvorschläge vorhanden sein -> bitte kurze PN an mich...

JPA
27.06.2006, 21:04
Hi,

zum Thema MultiLanguage gibt es noch eine Lösung (ohne INI-Dateien, sondern verwaltet über Tabellen direkt in Access):
http://ms-office-forum.net/forum/showthread.php?t=183039

Gruß
JPA