Hallo.
Ich kämpfe mal wieder mit einem Problem und hoffe, jemand von euch kann mir da weiterhelfen.
Ich sende ein Skript an BingMap um die Adressdaten in der Karte anzeigen zu lassen.
Function OpenMap(Address, City, State, Zipcode, Country)
Dim strAddress As String
strAddress = Nz(Address)
strAddress = strAddress & IIf(strAddress = "", "", ", ") & Nz(City)
strAddress = strAddress & IIf(strAddress = "", "", ", ") & Nz(State)
strAddress = strAddress & IIf(strAddress = "", "", ", ") & Nz(Zipcode)
strAddress = strAddress & IIf(strAddress = "", "", ", ") & Nz(Country)
If strAddress = "" Then
MsgBox "Keine zuzuordnende Adresse vorhanden."
Else
Application.FollowHyperlink "http://www.bing.com/maps/default.aspx?where1=" & strAddress
End If
End Function
Das funktioniert ohne weiteres für Adressdaten, die keine Umlaute beinhalten. Ist ein Umlaut in der Adresse vorhanden, wie zum Beispiel ,,München" erscheint Fehlermeldung.
Ich habe im Netzt diesen Code gefunden mit dem, wie ich finde das Problem lösen könnte. Den hab ich bereits in das Modul eingefügt.
Public Function Umlaut(pString As String) As String
'//********************************************************
'// Diese Funktion ersetzt in einem String sämtliche
'// Umlaute, egal ob gross oder klein geschrieben
'//
'// Original dieser Funktion aus der Tips&Tricks-Sammlung
'// von Reinhard Kraasch (www.kraasch.de)
'//
'//********************************************************
Dim I As Integer, Ch As String * 1, Ch1 As String * 1, _
IsUpCase As Boolean, Res As String
If IsNull(pString) Then Umlaut = Null: Exit Function
Res = ""
For I = 1 To Len(pString)
Ch = Mid(pString, I, 1)
Ch1 = IIf(I < Len(pString), Mid(pString, I + 1, 1), " ")
' Nächstes Zeichen ist kein Kleinbuchstabe:
IsUpCase = (Asc(Ch1) = Asc(UCase(Ch1)))
Select Case Asc(Ch)
Case Asc("Ä"): Res = Res & IIf(IsUpCase, "AE", "Ae")
Case Asc("Ö"): Res = Res & IIf(IsUpCase, "OE", "Oe")
Case Asc("Ü"): Res = Res & IIf(IsUpCase, "UE", "Ue")
Case Asc("ä"): Res = Res & "ae"
Case Asc("ö"): Res = Res & "oe"
Case Asc("ü"): Res = Res &a "ue"
Case Asc("ß"): Res = Res &a "ss"
Case Else: Res = Res & Ch
End Select
Next I
Umlaut = Res
End Function
Leider weiß ich, mangels meiner Kenntnisse nicht, wie ich das am besten einbinden soll. Die umlaute sollten nur für den Skriptversand geändert werden, jedoch nicht in der Tabelle.
Kann mir jemand helfen, um dies zu bewerkstelligen?
Danke schon mal im Voraus.
Grüße, Brane.
Hallo,
Du solltest die Umlaute in HTML umwandeln:
z.B. ü = %FC
https://de.wikipedia.org/wiki/Hilfe:Sonderzeichenreferenz
Application.FollowHyperlink "http://www.bing.com/maps/default.aspx?where1=" & fktUmlaut2HTML(strAddress)
Public Function fktUmlaut2HTML(byVal strString As String) As String
if Len(strString) = 0 then Exit Function
strString = Replace (strString,"ü","%FC")
strString = Replace (strString,"Ü","%DC")
.
.
.
fktUmlaut2HTML=strString
End Function
Hallo Franz.
Das ist die Lösung! Super! Vielen, vielen Dank. Funktioniert einwandfrei. Hut ab. :D
Viele Grüße
Brane. :)