Access2000 Zahlen in Text umwandeln
Michael Tiedemann
kann mir jemand einen Tip geben, wie ich eine Zahl (Währung) in einen
Text (Scheckvordruck) umwandeln kann?
Vielen Dank im Voraus
Michael
Mario Herger
Klaus Oberdalhoff zu finden.
Mario
____________________________________________________
AccessArchive: http://www.mherger.com/
APP: http://www.AccessProfiPool.com
FAQ: http://members.eunet.at/donkarl/AccessFAQ.htm
____________________________________________________
> kann mir jemand einen Tip geben, wie ich eine Zahl (Währung) in einen
> Text (Scheckvordruck) umwandeln kann?
---
Option Compare Database
Option Explicit
' Verschiedene Beispiele für "Zahl in Worte" aus der Newsgroup
' Ihr könnt euch eine davon aussuchen ...
' ############### Nummer 1 ################
'Aus der Newsgroup von Walter Wohlmuth
'folgendes Beispiel habe ich aus einem Access-VBA-Kurs mitbekommen, es
'funktioniert hervorragend (bei Zahlen unter 1 Milliarde):
Function CurStr(InputValue, Optional Round, Optional Nulls)
'Gibt #InputValue in Worten aus, wobei auf #Round gerundet wird
'Standardeinstellung #Round = 0 (ohne Nachkommastellen)
'z.B. #Round = 3 (nur Tausender), oder -2 (zwei Nachkommastellen)
'Standardeinstellung #Nulls = False (0 wird nicht ausgeschrieben)
If IsNull(InputValue) Then
CurStr = Null
Exit Function
End If
If VarType(Round) = vbError Then Round = 0
If VarType(Nulls) = vbError Then Nulls = False
Dim Dec As String
Select Case Round
Case Is > 0
InputValue = CLng((InputValue \ (10 ^ Round)) * (10 ^ Round))
Dec = "..."
Case -1
Dec = " komma " & CurStr((((InputValue - Int(InputValue)) *
100)
\ 10) * 10, , True)
InputValue = CLng(Int(InputValue))
Case Is < -1
Select Case (InputValue - Int(InputValue)) * 100
Case Is = 0
Dec = " komma null" 'oder Leerstring wenn nicht
geschrieben werden soll
Case 1 To 9
Dec = " komma null" & CurStr(((InputValue * 10 -
Int(InputValue * 10)) * 10), , True)
Case Else
Dec = " komma " & CurStr(((InputValue -
Int(InputValue))
* 100), , True)
End Select
InputValue = CLng(Int(InputValue))
Case Else
InputValue = CLng(Int(InputValue))
Dec = ""
End Select
Select Case InputValue
Case Is >= 1000000000
CurStr = "#FEHLER"
Case 0
CurStr = IIf(Nulls, "null", "") 'wenn Parameter Nulls wahr
ist
Case 1
CurStr = "ein"
Case 2
CurStr = "zwei"
Case 3
CurStr = "drei"
Case 4
CurStr = "vier"
Case 5
CurStr = "fünf"
Case 6
CurStr = "sechs"
Case 7
CurStr = "sieben"
Case 8
CurStr = "acht"
Case 9
CurStr = "neun"
Case 10
CurStr = "zehn"
Case 20
CurStr = "zwanzig"
Case 30
CurStr = "dreißig"
Case 40
CurStr = "vierzig"
Case 50
CurStr = "fünfzig"
Case 60
CurStr = "sechzig"
Case 70
CurStr = "siebzig"
Case 80
CurStr = "achzig"
Case 90
CurStr = "neunzig"
Case 11
CurStr = "elf"
Case 12
CurStr = "zwölf"
Case 13 To 19
CurStr = CurStr(InputValue - 10) & "zehn"
Case 100 To 999
CurStr = CurStr(InputValue \ 100) & "hundert" & _
CurStr(InputValue - ((InputValue \ 100) * 100))
Case 1000 To 999999
CurStr = CurStr(InputValue \ 1000) & "tausend " & _
CurStr(InputValue - ((InputValue \ 1000) * 1000))
Case 1000000 To 999999999
CurStr = CurStr(InputValue \ 1000000) & "million" & _
IIf(InputValue \ 1000000 = 1, " ", "en ") & CurStr(InputValue -
((InputValue
_
\ 1000000) * 1000000))
Case Else
CurStr = CurStr(InputValue - ((InputValue \ 10) * 10)) &
"und" &
_
CurStr(((InputValue \ 10) * 10))
End Select
CurStr = LTrim(Trim(CurStr) & Dec)
'ciao
'Walter Wohlmuth
End Function
'################ Nummer 2 ################################
Public Function FctZahl_In_Worten(Zahl As Double) As String
' Aus der Newsgroup von Karl Donaubauer
' Ausgabe einer Zahl als Wort
' Verwendet Private Function FctZif()
Dim Z As String, W As String
Dim R As Integer, I As Integer
Z = Int(Zahl)
If Z = 0 Then
W = "null"
Exit Function
End If
For I = 6 To 0 Step -3
If Len(Z) > I Then
R = Right(Int(Z / (10 ^ I)), 3)
If R > 99 Then W = FctZif(1, left(R, 1), W) & "hundert": R = Right(R,
2)
If R > 19 Then W = FctZif(3, Right(R, 1), W): W = FctZif(4, left(R,
1),
W)
If I = 0 And Right(Z, 3) Like "00*" And R > 0 Then W = W & "und"
If R < 10 Then W = FctZif(1, left(R, 1), W)
If R > 9 And R < 20 Then W = FctZif(2, Right(R, 1), W)
If I = 6 And Len(Z) = 7 And R = 1 Then W = "einemillion"
If I = 6 And Right(Int(Z / 10 ^ I), 3) > 1 Then W = W & "millionen"
If I = 3 And Right(Int(Z / 10 ^ I), 3) > 0 Then W = W & "tausend"
If I = 0 And R = 1 Then W = W & "s"
End If
Next
FctZahl_In_Worten = W
End Function
'*************************
Private Function FctZif(Par As Byte, R As String, W As String)
If R = 1 Then W = W & "ein"
If R = 2 Then W = W & "zwei"
If R = 3 Then W = W & "drei"
If R = 4 Then W = W & "vier"
If R = 5 Then W = W & "fünf"
If R = 6 Then W = W & "sech"
If R = 7 Then W = W & "sieb"
If R = 8 Then W = W & "acht"
If R = 9 Then W = W & "neun"
Select Case Par
Case 1, 3
If R = 6 Then W = W & "s"
If R = 7 Then W = W & "en"
If Par = 3 And R > 0 Then W = W & "und"
Case 2
W = W & "zehn"
If R = 1 Then W = left(W, Len(W) - 7) & "elf"
If R = 2 Then W = left(W, Len(W) - 8) & "zwölf"
Case 4
If R = 2 Then W = left(W, Len(W) - 4) & "zwan"
W = W & "zig"
If R = 3 Then W = left(W, Len(W) - 3) & "ßig"
End Select
FctZif = W
End Function
'############# Nummer 3 ####################
Function ZahlInWorten(betrag As String)
' Aus der Newsgroup von Michael Steinböck
'so gehts auch ... ich hab ein paar leerzeichen mehr drin aber sonst
scheint
'beides zu funzen ...
'Damals fand ich es interessant, rauszukriegen, wie die Regeln lauten :
'hundrerterstelle, einerstelle, zehnerstelle, mit ein paar ausnahmen ...
Static STW$(18) ' Anzahl der möglichen Stellen
Static ZAH$(10) ' Anzahl der Ziffern (Zehnersystem!)
Static TAU$(20, 2) 'Austausch für/wegen Besonderheiten
Dim T$, A$, K, L, Z, UND$, I, J
'Bezeichnungen für Stellenwerte
STW$(0) = "und"
STW$(1) = ""
STW$(2) = "zig"
STW$(3) = "hundert"
STW$(4) = "tausend "
STW$(5) = ""
STW$(6) = ""
STW$(7) = " Millionen "
STW$(10) = " Milliarden "
STW$(13) = " Billionen "
STW$(16) = " Billiarden"
' und so weiter ....
'Namen der Ziffern
ZAH$(0) = ""
ZAH$(1) = "ein"
ZAH$(2) = "zwei"
ZAH$(3) = "drei"
ZAH$(4) = "vier"
ZAH$(5) = "fünf"
ZAH$(6) = "sechs"
ZAH$(7) = "sieben"
ZAH$(8) = "acht"
ZAH$(9) = "neun"
' Auszutauschende Zeichenketten
TAU$(0, 0) = "ein ": TAU$(0, 1) = "eins"
TAU$(1, 0) = "einzig": TAU$(1, 1) = "zehn"
TAU$(2, 0) = "zweizig": TAU$(2, 1) = "zwanzig"
TAU$(3, 0) = "dreizig": TAU$(3, 1) = "dreissig"
TAU$(4, 0) = "sechszig": TAU$(4, 1) = "sechzig"
TAU$(5, 0) = "siebenzig": TAU$(5, 1) = "siebzig"
TAU$(6, 0) = "einundzehn": TAU$(6, 1) = "elf"
TAU$(7, 0) = "zweiundzehn": TAU$(7, 1) = "zwölf"
TAU$(8, 0) = "dreiundzehn": TAU$(8, 1) = "dreizehn"
TAU$(9, 0) = "vierundzehn": TAU$(9, 1) = "vierzehn"
TAU$(10, 0) = "fünfundzehn": TAU$(10, 1) = "fünfzehn"
TAU$(11, 0) = "sechsundzehn": TAU$(11, 1) = "sechzehn"
TAU$(12, 0) = "siebenundzehn": TAU$(12, 1) = "siebzehn"
TAU$(13, 0) = "achtundzehn": TAU$(13, 1) = "achtzehn"
TAU$(14, 0) = "neunundzehn": TAU$(14, 1) = "neunzehn"
TAU$(15, 0) = "einsmillionen": TAU$(15, 1) = "eine Million "
TAU$(16, 0) = "einsmilliarden": TAU$(16, 1) = "eine Milliarde "
TAU$(17, 0) = "einsbillionen": TAU$(17, 1) = "eine Billion "
TAU$(18, 0) = "einsbilliarden": TAU$(18, 1) = "eine Billiarde "
T$ = ""
A$ = " " & Format(Int(betrag), "0")
A$ = Right(A$, 18)
For K = 3 To Len(A$) Step 3 ' Gruppe aus 3 Ziffern
If Val(Mid(A$, K - 2, 3)) > 0 Then 'wenn diese drei einen wert haben
L = 2 ' hunderterstelle
Z = Val(Mid(A$, K - L, 1)) ' Ziffer an der Stelle
If Z > 0 Then T$ = T$ & ZAH$(Z) & STW(3) Else If Len(T$) > 0 Then
T$
= T$ & STW(0) & " "
L = 0 ' Einerstelle
UND$ = ""
Z = Val(Mid(A$, K - L, 1))
If Z > 0 Then T$ = T$ & ZAH$(Z): UND$ = STW(0)
L = 1 ' zehnerstelle
Z = Val(Mid(A$, K - L, 1))
If Z > 0 Then T$ = T$ & UND$ & ZAH$(Z) + STW(2)
T$ = T$ & STW$(Len(A$) - K + 1) 'Bezeichnung der 3er Gruppe (tausend,
millionen ...
End If
Next
T$ = T$ & " "
For I = 0 To 18 ' Anzahl der Austausche siehe oben TAU$ definiert
nextone:
J = InStr(1, T$, TAU$(I, 0), 1) 'ist der auszutauschende Text
'im vorläufigen Ausgabestring?
If J > 0 Then
T$ = Mid(T$, 1, J - 1) & TAU$(I, 1) & Mid$(T$, J +
Len(TAU$(I,
0)))
GoTo nextone ' Probiere noch einmal
End If
Next
ZahlInWorten = T$
End Function
Stefan Leitner
Schau Dir mal FAQ 1.21 an
Grüße aus Neumarkt
Stefan
Michael Tiedemann schrieb:
>
> Hi,
> kann mir jemand einen Tip geben, wie ich eine Zahl (Währung) in einen
> Text (Scheckvordruck) umwandeln kann?
>
Karl Donaubauer
>kann mir jemand einen Tip geben, wie ich eine Zahl (Währung) in einen
>Text (Scheckvordruck) umwandeln kann?
FAQ 1.21 Zahl in Worten
HTH
Karl
********* Ich beantworte keine Access-Fragen per Email. *********
Access-FAQ: http://members.eunet.at/donkarl/
APP: http://www.AccessProfiPool.com
Klaus Oberdalhoff
> kann mir jemand einen Tip geben, wie ich eine Zahl (Währung) in einen
> Text (Scheckvordruck) umwandeln kann?
entweder die KnowHow.mdb (www.accessware.de) runterladen, da ist auch für
diesen Fall etwas dabei oder Access-FAQ 1.21 lesen
Access-FAQ bei: http://members.eunet.at/donkarl/
--
mfg
Klaus KO...@gmx.de
PS:Tips und Tricks zu ACCESS 97 (** KnowHow-MDB ** Ver 3.0 - 30.9.1999)
unter http://www.accessware.de/
Access-FAQ bei: http://members.eunet.at/donkarl/