vb programiranje

[ bonkic @ 11.09.2010. 19:19 ] @

dečki trebam kod za pretvaranje brojeva u tekst. nesto čačkam po excellu i trebam npr pretvorit 125,12 KM u stotinudvadesetpet KM i 12/100. pomoć! dakle kod u vb tako da mogu pomoću makronaredbe pokrenit.

[ captPicard @ 13.09.2010. 10:28 ] @

Ima forum search funkciju :)

[ srdjan_m @ 13.09.2010. 14:09 ] @

Originalna funkcija prilagođena američkom načinu pisanja brojeva: http://forums.asp.net/p/1018982/1376382.aspx
A ovo je ta ista funkcija prilagođena našem jeziku i dosta dobro funkcioniše:

Code:
Private Function NumToText(dblVal As Double) As String
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Static bInit As Boolean
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
Dim strVal As String, strBuff As String, strTemp As String
Dim nCol As Integer, nChar As Integer

'Only handles positive values
Debug.Assert dblVal >= 0

If bInit = False Then
'Initialize array
bInit = True
Ones(0) = "nula"
Ones(1) = "jedan"
Ones(2) = "dva"
Ones(3) = "tri"
Ones(4) = "cetiri"
Ones(5) = "pet"
Ones(6) = "sest"
Ones(7) = "sedam"
Ones(8) = "osam"
Ones(9) = "devet"
Teens(0) = "deset"
Teens(1) = "jedanaest"
Teens(2) = "dvanaest"
Teens(3) = "trinaest"
Teens(4) = "cetrnaest"
Teens(5) = "petnaest"
Teens(6) = "sesnaest"
Teens(7) = "sedamnaest"
Teens(8) = "osamnaest"
Teens(9) = "devetnaest"
Tens(0) = ""
Tens(1) = "deset"
Tens(2) = "dvadeset"
Tens(3) = "trideset"
Tens(4) = "cetrdeset"
Tens(5) = "pedeset"
Tens(6) = "sezdeset"
Tens(7) = "sedamdeset"
Tens(8) = "osamdeset"
Tens(9) = "devedeset"
Thousands(0) = ""
Thousands(1) = "hiljada" 'US numbering
Thousands(2) = "milion"
Thousands(3) = "milijarda"
Thousands(4) = "bilion"
End If
'Trap errors
On Error GoTo NumToTextError
'Get fractional part
strBuff = "dinara i " & Format((dblVal - Int(dblVal)) * 100, "00") & "/100"
'Convert rest to string and process each digit
strVal = CStr(Int(dblVal))
'Non-zero digit not yet encountered
bAllZeros = True
'Iterate through string
For i = Len(strVal) To 1 Step -1
'Get value of this digit
nChar = Val(mID$(strVal, i, 1))
'Get column position
nCol = (Len(strVal) - i) + 1
'Action depends on 1's, 10's or 100's column
Select Case (nCol Mod 3)
Case 1 '1's position
bShowThousands = True
If i = 1 Then
'First digit in number (last in loop)
strTemp = Ones(nChar) & ""
ElseIf mID$(strVal, i - 1, 1) = "1" Then
'This digit is part of "teen" number
strTemp = Teens(nChar) & ""
i = i - 1 'Skip tens position
ElseIf nChar > 0 Then
'Any non-zero digit
strTemp = Ones(nChar) & ""
Else
'This digit is zero. If digit in tens and hundreds column
'are also zero, don't show "thousands"
bShowThousands = False
'Test for non-zero digit in this grouping
If mID$(strVal, i - 1, 1) <> "0" Then
bShowThousands = True
ElseIf i > 2 Then
If mID$(strVal, i - 2, 1) <> "0" Then
bShowThousands = True
End If
End If
strTemp = ""
End If
'Show "thousands" if non-zero in grouping
If bShowThousands Then
If nCol > 1 Then
strTemp = strTemp & Thousands(nCol \ 3)
End If
'Indicate non-zero digit encountered
bAllZeros = False
End If
strBuff = strTemp & strBuff
Case 2 '10's position
If nChar > 0 Then
strBuff = Tens(nChar) & "" & strBuff
End If
Case 0 '100's position

If nChar = 1 Then
Ones(1) = "jedna"
strBuff = Ones(nChar) & "stotina" & strBuff
End If
If nChar = 2 Or nChar = 3 Or nChar = 4 Then
Ones(2) = "dve"
strBuff = Ones(nChar) & "stotine" & strBuff
End If
If nChar > 4 Then
strBuff = Ones(nChar) & "stotina" & strBuff
End If
End Select
Next i

'Convert first letter to upper case
strBuff = "SLOVIMA: " & LCase$(Left$(strBuff, 1)) & mID$(strBuff, 2)
EndNumToText:
'Return result
NumToText = strBuff
Exit Function
NumToTextError:
strBuff = "#Error#"
Resume EndNumToText
End Function

_{Edit > Marko_L: Dodati code tagovi}

_{[Ovu poruku je menjao Marko_L dana 13.09.2010. u 23:07 GMT+1]}

[ bonkic @ 13.09.2010. 20:32 ] @

>

--001485f6c76205b20904902927ad
Content-Type: text/html; charset=ISO-8859-2
Content-Transfer-Encoding: quoted-printable

Zahvljujem pajdo,ve� sam par kodova skinuo ali ovaj dosada najbolje radi! ovo �e mi zna�ajno ubrzati rad u firmi, velika hvala! <div class="gmail_quote">2010/9/13 srdjan_m <<a href="mailto:[email protected]">[email protected]</a>> 
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">Evo, ovo je funkcija prilago�ena na�em jeziku i dosta dobro funkcioni�e: 
 
 
Private Function NumToText(dblVal As Double) As String 
Static Ones(0 To 9) As String 
Static Teens(0 To 9) As String 
Static Tens(0 To 9) As String 
Static Thousands(0 To 4) As String 
Static bInit As Boolean 
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean 
Dim strVal As String, strBuff As String, strTemp As String 
Dim nCol As Integer, nChar As Integer 
 
'Only handles positive values 
Debug.Assert dblVal >= 0 
 
If bInit = False Then 
'Initialize array 
bInit = True 
Ones(0) = "nula" 
Ones(1) = "jedan" 
Ones(2) = "dva" 
Ones(3) = "tri" 
Ones(4) = "cetiri" 
Ones(5) = "pet" 
Ones(6) = "sest" 
Ones(7) = "sedam" 
Ones(8) = "osam" 
Ones(9) = "devet" 
Teens(0) = "deset" 
Teens(1) = "jedanaest" 
Teens(2) = "dvanaest" 
Teens(3) = "trinaest" 
Teens(4) = "cetrnaest" 
Teens(5) = "petnaest" 
Teens(6) = "sesnaest" 
Teens(7) = "sedamnaest" 
Teens(8) = "osamnaest" 
Teens(9) = "devetnaest" 
Tens(0) = "" 
Tens(1) = "deset" 
Tens(2) = "dvadeset" 
Tens(3) = "trideset" 
Tens(4) = "cetrdeset" 
Tens(5) = "pedeset" 
Tens(6) = "sezdeset" 
Tens(7) = "sedamdeset" 
Tens(8) = "osamdeset" 
Tens(9) = "devedeset" 
Thousands(0) = "" 
Thousands(1) = "hiljada" 'US numbering 
Thousands(2) = "milion" 
Thousands(3) = "milijarda" 
Thousands(4) = "bilion" 
End If 
'Trap errors 
On Error GoTo NumToTextError 
'Get fractional part 
strBuff = "dinara i " & Format((dblVal - Int(dblVal)) * 100, "00") & "/100" 
'Convert rest to string and process each digit 
strVal = CStr(Int(dblVal)) 
'Non-zero digit not yet encountered 
bAllZeros = True 
'Iterate through string 
For i = Len(strVal) To 1 Step -1 
'Get value of this digit 
nChar = Val(mID$(strVal, i, 1)) 
'Get column position 
nCol = (Len(strVal) - i) + 1 
'Action depends on 1's, 10's or 100's column 
Select Case (nCol Mod 3) 
Case 1 '1's position 
bShowThousands = True 
If i = 1 Then 
'First digit in number (last in loop) 
strTemp = Ones(nChar) & "" 
ElseIf mID$(strVal, i - 1, 1) = "1" Then 
'This digit is part of "teen" number 
strTemp = Teens(nChar) & "" 
i = i - 1 'Skip tens position 
ElseIf nChar > 0 Then 
'Any non-zero digit 
strTemp = Ones(nChar) & "" 
Else 
'This digit is zero. If digit in tens and hundreds column 
'are also zero, don't show "thousands" 
bShowThousands = False 
'Test for non-zero digit in this grouping 
If mID$(strVal, i - 1, 1) <> "0" Then 
bShowThousands = True 
ElseIf i > 2 Then 
If mID$(strVal, i - 2, 1) <> "0" Then 
bShowThousands = True 
End If 
End If 
strTemp = "" 
End If 
'Show "thousands" if non-zero in grouping 
If bShowThousands Then 
If nCol > 1 Then 
strTemp = strTemp & Thousands(nCol 3) 
End If 
'Indicate non-zero digit encountered 
bAllZeros = False 
End If 
strBuff = strTemp & strBuff 
Case 2 '10's position 
If nChar > 0 Then 
strBuff = Tens(nChar) & "" & strBuff 
End If 
Case 0 '100's position 
 
If nChar = 1 Then 
Ones(1) = "jedna" 
strBuff = Ones(nChar) & "stotina" & strBuff 
End If 
If nChar = 2 Or nChar = 3 Or nChar = 4 Then 
Ones(2) = "dve" 
strBuff = Ones(nChar) & "stotine" & strBuff 
End If 
If nChar > 4 Then 
strBuff = Ones(nChar) & "stotina" & strBuff 
End If 
End Select 
Next i 
 
'Convert first letter to upper case 
strBuff = "SLOVIMA: " & LCase$(Left$(strBuff, 1)) & mID$(strBuff, 2) 
EndNumToText: 
'Return result 
NumToText = strBuff 
Exit Function 
NumToTextError: 
strBuff = "#Error#" 
Resume EndNumToText 
End Function 
 
-- 
<a href="http://www.elitesecurity.org/p2692926" target="_blank">http://www.elitesecurity.org/p2692926</a> 
<div><div></div><div class="h5"> 
Prijave/odjave: <a href="http://www.elitesecurity.org/pracenje#409492" target="_blank">http://www.elitesecurity.org/pracenje#409492</a> 
 
Ne menjajte sledece dve linije ukoliko odgovarate putem emaila! 
esauth:409492:c8d4acf4eaeac6e1c3cc5367071b9fde