von MH50 » Di, 13.12.2011 00:02
Aber klar doch. Weiß nicht, ob meine Lösung besonders elegant ist, aber es geht.
Hier der Code:
Code: Alles auswählen
Sub CalcName
oform = Thiscomponent.drawpage.forms.getbyname("Formular")
oVN = oform.getbyname("Textfeld1")'Eingabefeld
oNN = oform.getbyname("Textfeld2")'Ausgabefeld
sString=oVN.Text+oNN.Text 'Vor- + Nachname einlesen
dim kabal(1,34) as string 'Array mit "Ersetzungstabelle". Die längste Zeichenkette muss ganz am Anfang stehen!
kabal(0,0) = "SCH": kabal(1,0) = "18"
kabal(0,1) = "TH": kabal(1,1) = "22"
kabal(0,2) = "CK": kabal(1,2) = "4"
kabal(0,3) = "PH": kabal(1,3) = "17"
kabal(0,4) = "A": kabal(1,4) = "1"
kabal(0,5) = "B": kabal(1,5) = "2"
kabal(0,6) = "C": kabal(1,6) = "3"
kabal(0,7) = "D": kabal(1,7) = "4"
kabal(0,8) = "E": kabal(1,8) = "5"
kabal(0,9) = "F": kabal(1,9) = "8"
kabal(0,10) = "G": kabal(1,10) = "3"
kabal(0,11) = "H": kabal(1,11) = "5"
kabal(0,12) = "I": kabal(1,12) = "1"
kabal(0,13) = "J": kabal(1,13) = "1"
kabal(0,14) = "K": kabal(1,14) = "2"
kabal(0,15) = "L": kabal(1,15) = "3"
kabal(0,16) = "M": kabal(1,16) = "4"
kabal(0,17) = "N": kabal(1,17) = "5"
kabal(0,18) = "O": kabal(1,18) = "7"
kabal(0,19) = "P": kabal(1,19) = "8"
kabal(0,20) = "Q": kabal(1,20) = "1"
kabal(0,21) = "R": kabal(1,21) = "2"
kabal(0,22) = "S": kabal(1,22) = "3"
kabal(0,23) = "T": kabal(1,23) = "4"
kabal(0,24) = "U": kabal(1,24) = "6"
kabal(0,25) = "V": kabal(1,25) = "6"
kabal(0,26) = "W": kabal(1,26) = "6"
kabal(0,27) = "X": kabal(1,27) = "5"
kabal(0,28) = "Y": kabal(1,28) = "1"
kabal(0,29) = "Z": kabal(1,29) = "7"
kabal(0,30) = "Ä": kabal(1,30) = "6"
kabal(0,31) = "Ö": kabal(1,31) = "12"
kabal(0,32) = "Ü": kabal(1,32) = "11"
kabal(0,33) = "ß": kabal(1,33) = "6"
kabal(0,34) = "-": kabal(1,34) = "0"
for i=0 to 34
sLetter=kabal(0,i)'Buchstabe/n auslesen
nStringlen=len(sLetter)'Länge
sNumber=kabal(1,i)&"," 'Zahl auslesen + Komma dahinter setzen
for k=1 to len(sString)
npos = InStr(1, sString, sLetter,1 )
if npos>0 then
sString= Replace(sString,(mid(sString,npos,nStringlen)),sNumber)
endif
next k
next i
msgbox "Name übersetzt in Zahlen:"&Chr(13)& sString
Dim QSVName As Integer
dim b as Integer
dim String1 as String
String1=CStr(sString) 'Eingabe in String umwandeln, um Anzahl der Stellen zu ermitteln und mit den Stellen zu rechnen
ArrayStr1=split(sString,",")
for i=0 to uBound(ArrayStr1)-1 'Anzahl Stellen bestimmt Anzahl Durchläufe
b=b+CInt(ArrayStr1(i,0)) 'Stelle für Stelle addieren
next
QSVName=b
Print "Die Quersumme ist: "& QSVName 'Ergebnis anzeigen
End Sub
Na, mal sehen, was die Profis dazu sagen.
Gruß
MH50
Aber klar doch. Weiß nicht, ob meine Lösung besonders elegant ist, aber es geht.
Hier der Code:
[code]Sub CalcName
oform = Thiscomponent.drawpage.forms.getbyname("Formular")
oVN = oform.getbyname("Textfeld1")'Eingabefeld
oNN = oform.getbyname("Textfeld2")'Ausgabefeld
sString=oVN.Text+oNN.Text 'Vor- + Nachname einlesen
dim kabal(1,34) as string 'Array mit "Ersetzungstabelle". Die längste Zeichenkette muss ganz am Anfang stehen!
kabal(0,0) = "SCH": kabal(1,0) = "18"
kabal(0,1) = "TH": kabal(1,1) = "22"
kabal(0,2) = "CK": kabal(1,2) = "4"
kabal(0,3) = "PH": kabal(1,3) = "17"
kabal(0,4) = "A": kabal(1,4) = "1"
kabal(0,5) = "B": kabal(1,5) = "2"
kabal(0,6) = "C": kabal(1,6) = "3"
kabal(0,7) = "D": kabal(1,7) = "4"
kabal(0,8) = "E": kabal(1,8) = "5"
kabal(0,9) = "F": kabal(1,9) = "8"
kabal(0,10) = "G": kabal(1,10) = "3"
kabal(0,11) = "H": kabal(1,11) = "5"
kabal(0,12) = "I": kabal(1,12) = "1"
kabal(0,13) = "J": kabal(1,13) = "1"
kabal(0,14) = "K": kabal(1,14) = "2"
kabal(0,15) = "L": kabal(1,15) = "3"
kabal(0,16) = "M": kabal(1,16) = "4"
kabal(0,17) = "N": kabal(1,17) = "5"
kabal(0,18) = "O": kabal(1,18) = "7"
kabal(0,19) = "P": kabal(1,19) = "8"
kabal(0,20) = "Q": kabal(1,20) = "1"
kabal(0,21) = "R": kabal(1,21) = "2"
kabal(0,22) = "S": kabal(1,22) = "3"
kabal(0,23) = "T": kabal(1,23) = "4"
kabal(0,24) = "U": kabal(1,24) = "6"
kabal(0,25) = "V": kabal(1,25) = "6"
kabal(0,26) = "W": kabal(1,26) = "6"
kabal(0,27) = "X": kabal(1,27) = "5"
kabal(0,28) = "Y": kabal(1,28) = "1"
kabal(0,29) = "Z": kabal(1,29) = "7"
kabal(0,30) = "Ä": kabal(1,30) = "6"
kabal(0,31) = "Ö": kabal(1,31) = "12"
kabal(0,32) = "Ü": kabal(1,32) = "11"
kabal(0,33) = "ß": kabal(1,33) = "6"
kabal(0,34) = "-": kabal(1,34) = "0"
for i=0 to 34
sLetter=kabal(0,i)'Buchstabe/n auslesen
nStringlen=len(sLetter)'Länge
sNumber=kabal(1,i)&"," 'Zahl auslesen + Komma dahinter setzen
for k=1 to len(sString)
npos = InStr(1, sString, sLetter,1 )
if npos>0 then
sString= Replace(sString,(mid(sString,npos,nStringlen)),sNumber)
endif
next k
next i
msgbox "Name übersetzt in Zahlen:"&Chr(13)& sString
Dim QSVName As Integer
dim b as Integer
dim String1 as String
String1=CStr(sString) 'Eingabe in String umwandeln, um Anzahl der Stellen zu ermitteln und mit den Stellen zu rechnen
ArrayStr1=split(sString,",")
for i=0 to uBound(ArrayStr1)-1 'Anzahl Stellen bestimmt Anzahl Durchläufe
b=b+CInt(ArrayStr1(i,0)) 'Stelle für Stelle addieren
next
QSVName=b
Print "Die Quersumme ist: "& QSVName 'Ergebnis anzeigen
End Sub[/code]
Na, mal sehen, was die Profis dazu sagen.
Gruß
MH50