Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

vb programiranje

[es] :: Visual Basic 6 :: vb programiranje

[ Pregleda: 3375 | Odgovora: 3 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

bonkic

Član broj: 268153
Poruke: 2
*.tel.net.ba.



Profil

icon vb programiranje11.09.2010. u 19:19 - pre 164 meseci
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.
 
Odgovor na temu

captPicard
programer
more i planine

Član broj: 216084
Poruke: 1119



+19 Profil

icon Re: vb programiranje13.09.2010. u 10:28 - pre 164 meseci
Ima forum search funkciju :)
F
 
Odgovor na temu

srdjan_m
Programer
St.Pazova

Član broj: 29217
Poruke: 262
*.masel.rs.



+12 Profil

icon Re: vb programiranje13.09.2010. u 14:09 - pre 164 meseci
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]
 
Odgovor na temu

bonkic

Član broj: 268153
Poruke: 2
*.com
Via: [es] mailing liste



Profil

icon Re: vb programiranje13.09.2010. u 20:32 - pre 164 meseci
>

--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!<br><br><div class="gmail_quote">2010/9/13 srdjan_m <span dir="ltr">&lt;<a href="mailto:[email protected]">[email protected]</a>&gt;</span><br>
<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:<br>
<br>
<br>
Private Function NumToText(dblVal As Double) As String<br>
Static Ones(0 To 9) As String<br>
Static Teens(0 To 9) As String<br>
Static Tens(0 To 9) As String<br>
Static Thousands(0 To 4) As String<br>
Static bInit As Boolean<br>
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean<br>
Dim strVal As String, strBuff As String, strTemp As String<br>
Dim nCol As Integer, nChar As Integer<br>
<br>
&#39;Only handles positive values<br>
Debug.Assert dblVal &gt;= 0<br>
<br>
If bInit = False Then<br>
&#39;Initialize array<br>
bInit = True<br>
Ones(0) = &quot;nula&quot;<br>
Ones(1) = &quot;jedan&quot;<br>
Ones(2) = &quot;dva&quot;<br>
Ones(3) = &quot;tri&quot;<br>
Ones(4) = &quot;cetiri&quot;<br>
Ones(5) = &quot;pet&quot;<br>
Ones(6) = &quot;sest&quot;<br>
Ones(7) = &quot;sedam&quot;<br>
Ones(8) = &quot;osam&quot;<br>
Ones(9) = &quot;devet&quot;<br>
Teens(0) = &quot;deset&quot;<br>
Teens(1) = &quot;jedanaest&quot;<br>
Teens(2) = &quot;dvanaest&quot;<br>
Teens(3) = &quot;trinaest&quot;<br>
Teens(4) = &quot;cetrnaest&quot;<br>
Teens(5) = &quot;petnaest&quot;<br>
Teens(6) = &quot;sesnaest&quot;<br>
Teens(7) = &quot;sedamnaest&quot;<br>
Teens(8) = &quot;osamnaest&quot;<br>
Teens(9) = &quot;devetnaest&quot;<br>
Tens(0) = &quot;&quot;<br>
Tens(1) = &quot;deset&quot;<br>
Tens(2) = &quot;dvadeset&quot;<br>
Tens(3) = &quot;trideset&quot;<br>
Tens(4) = &quot;cetrdeset&quot;<br>
Tens(5) = &quot;pedeset&quot;<br>
Tens(6) = &quot;sezdeset&quot;<br>
Tens(7) = &quot;sedamdeset&quot;<br>
Tens(8) = &quot;osamdeset&quot;<br>
Tens(9) = &quot;devedeset&quot;<br>
Thousands(0) = &quot;&quot;<br>
Thousands(1) = &quot;hiljada&quot; &#39;US numbering<br>
Thousands(2) = &quot;milion&quot;<br>
Thousands(3) = &quot;milijarda&quot;<br>
Thousands(4) = &quot;bilion&quot;<br>
End If<br>
&#39;Trap errors<br>
On Error GoTo NumToTextError<br>
&#39;Get fractional part<br>
strBuff = &quot;dinara i &quot; &amp; Format((dblVal - Int(dblVal)) * 100, &quot;00&quot;) &amp; &quot;/100&quot;<br>
&#39;Convert rest to string and process each digit<br>
strVal = CStr(Int(dblVal))<br>
&#39;Non-zero digit not yet encountered<br>
bAllZeros = True<br>
&#39;Iterate through string<br>
For i = Len(strVal) To 1 Step -1<br>
&#39;Get value of this digit<br>
nChar = Val(mID$(strVal, i, 1))<br>
&#39;Get column position<br>
nCol = (Len(strVal) - i) + 1<br>
&#39;Action depends on 1&#39;s, 10&#39;s or 100&#39;s column<br>
Select Case (nCol Mod 3)<br>
Case 1 &#39;1&#39;s position<br>
bShowThousands = True<br>
If i = 1 Then<br>
&#39;First digit in number (last in loop)<br>
strTemp = Ones(nChar) &amp; &quot;&quot;<br>
ElseIf mID$(strVal, i - 1, 1) = &quot;1&quot; Then<br>
&#39;This digit is part of &quot;teen&quot; number<br>
strTemp = Teens(nChar) &amp; &quot;&quot;<br>
i = i - 1 &#39;Skip tens position<br>
ElseIf nChar &gt; 0 Then<br>
&#39;Any non-zero digit<br>
strTemp = Ones(nChar) &amp; &quot;&quot;<br>
Else<br>
&#39;This digit is zero. If digit in tens and hundreds column<br>
&#39;are also zero, don&#39;t show &quot;thousands&quot;<br>
bShowThousands = False<br>
&#39;Test for non-zero digit in this grouping<br>
If mID$(strVal, i - 1, 1) &lt;&gt; &quot;0&quot; Then<br>
bShowThousands = True<br>
ElseIf i &gt; 2 Then<br>
If mID$(strVal, i - 2, 1) &lt;&gt; &quot;0&quot; Then<br>
bShowThousands = True<br>
End If<br>
End If<br>
strTemp = &quot;&quot;<br>
End If<br>
&#39;Show &quot;thousands&quot; if non-zero in grouping<br>
If bShowThousands Then<br>
If nCol &gt; 1 Then<br>
strTemp = strTemp &amp; Thousands(nCol 3)<br>
End If<br>
&#39;Indicate non-zero digit encountered<br>
bAllZeros = False<br>
End If<br>
strBuff = strTemp &amp; strBuff<br>
Case 2 &#39;10&#39;s position<br>
If nChar &gt; 0 Then<br>
strBuff = Tens(nChar) &amp; &quot;&quot; &amp; strBuff<br>
End If<br>
Case 0 &#39;100&#39;s position<br>
<br>
If nChar = 1 Then<br>
Ones(1) = &quot;jedna&quot;<br>
strBuff = Ones(nChar) &amp; &quot;stotina&quot; &amp; strBuff<br>
End If<br>
If nChar = 2 Or nChar = 3 Or nChar = 4 Then<br>
Ones(2) = &quot;dve&quot;<br>
strBuff = Ones(nChar) &amp; &quot;stotine&quot; &amp; strBuff<br>
End If<br>
If nChar &gt; 4 Then<br>
strBuff = Ones(nChar) &amp; &quot;stotina&quot; &amp; strBuff<br>
End If<br>
End Select<br>
Next i<br>
<br>
&#39;Convert first letter to upper case<br>
strBuff = &quot;SLOVIMA: &quot; &amp; LCase$(Left$(strBuff, 1)) &amp; mID$(strBuff, 2)<br>
EndNumToText:<br>
&#39;Return result<br>
NumToText = strBuff<br>
Exit Function<br>
NumToTextError:<br>
strBuff = &quot;#Error#&quot;<br>
Resume EndNumToText<br>
End Function<br>
<font color="#888888"><br>
--<br>
<a href="http://www.elitesecurity.org/p2692926" target="_blank">http://www.elitesecurity.org/p2692926</a><br>
</font><div><div></div><div class="h5"><br>
Prijave/odjave: <a href="http://www.elitesecurity.org/pracenje#409492" target="_blank">http://www.elitesecurity.org/pracenje#409492</a><br>
<br>
Ne menjajte sledece dve linije ukoliko odgovarate putem emaila!<br>
esauth:409492:c8d4acf4eaeac6e1c3cc5367071b9fde<br>
 
Odgovor na temu

[es] :: Visual Basic 6 :: vb programiranje

[ Pregleda: 3375 | Odgovora: 3 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.