[es] - [Excel] Konvertovanje Macro Modula iz Excela u Open office

ivangeta
Ivan Mihajlović
IT Menager & Network Administrator
Negotin

Član broj: 153906
Poruke: 8
91.150.126.*

Sajt: www.ivanm.tk

Profil

[Excel] Konvertovanje Macro Modula iz Excela u Open office

^{06.03.2008. u 08:41 - pre 196 meseci}

Pozdrav Svima!
Imam jedan mali problem! U excelu sam postavio macro modul koji konvertuje brojeve u slova !
Ali eto ti vraga Open Office ne može da otvori taj modul jer je pisan u VB u excelu.
Postoji li neki način da prebacim taj modul u open office ili zna li neko da prepravi ovaj modul za Open Office ?
Evo modula za VB :

Function slovima(broj)

If broj = 0 Then rez = "nula"

ReDim imebr(9)
imebr(1) = "jedan"
imebr(2) = "dva"
imebr(3) = "tri"
imebr(4) = ChrW(269) + "etiri"
imebr(5) = "pet"
imebr(6) = "šest"
imebr(7) = "sedam"
imebr(8) = "osam"
imebr(9) = "devet"

rez = ""
celi = Int(broj)
dec = ((broj - celi) * 100) Mod 100
cbr = Str(celi)
duzina = 16 - Len(cbr)
cBroj = String(duzina, "0") & Right(cbr, Len(cbr) - 1)

i = 1

Do While i < 15
tric = Mid(cBroj, i, 3)
trojka = Val(tric)
If tric <> "000" Then
cs = Val(Mid(tric, 1, 1))
cd = Val(Mid(tric, 2, 1))
cj = Val(Mid(tric, 3, 1))
Select Case cs
Case 2
rez = rez & "dve"
Case Is > 2
rez = rez & imebr(cs)
End Select

Select Case cs
Case 1
rez = rez & "stotinu"
Case 2, 3, 4
rez = rez & "stotine"
Case Is > 4
rez = rez & "stotina"
End Select

If cj = 0 Then sl1 = "" Else sl1 = imebr(cj)

Select Case cd
Case 4
rez = rez & ChrW(269) + "etr"
Case 6
rez = rez & "šez"
Case 5
rez = rez & "pe"
Case 9
rez = rez & "deve"
Case 2, 3, 7, 8
rez = rez & imebr(cd)
Case 1
sl1 = ""
Select Case cj
Case 0
rez = rez & "deset"
Case 1
rez = rez & "jeda"
Case 4
rez = rez & "četr"
Case Else
rez = rez & imebr(cj)
End Select
If cj > 0 Then rez = rez & "naest"
End Select

If cd > 1 Then rez = rez & "deset"

If (i = 4 Or i = 10) And cd <> 1 Then
If cj = 1 Then
sl1 = "jedna"
ElseIf cj = 2 Then
sl1 = "dve"
End If
End If

rez = rez & sl1

Select Case i

Case 1
rez = rez & "bilion"
If cj > 1 Or cd = 1 Then rez = rez & "a"

Case 4
rez = rez & "milijard"
If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Then
rez = rez & "i"
ElseIf cj = 1 Then
rez = rez & "a"
ElseIf cj > 4 Or cj = 0 Then
rez = rez & "i"
ElseIf cj > 1 Then
rez = rez & "e"
End If

Case 7
rez = rez & "milion"
If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj <> 1 Then
rez = rez & "a"
End If

Case 10
rez = rez & "hiljad"
If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj = 1 Then
rez = rez & "a"
ElseIf trojka = 1 Then
rez = rez & "u"
ElseIf cj > 4 Or cj = 0 Then
rez = rez & "a"
ElseIf cj > 1 Then
rez = rez & "e"
End If

End Select
End If
i = i + 3
Loop
rez = UCase(Left(rez, 1)) & Right(rez, Len(rez) - 1)
slovima = "Slovima : "& rez & " dinara i " & Str(dec) & "/00" & " para"

End Function

Ja sam je nešto menjao da ispisuje recimo 150,25 kao : Salovima : Stopedeset dinara i 25/00 para

MOLIM AKO NEKO ZNA DA PREPRAVI OVAJ MODUL ZA OPEN OFFICE ??????

Odgovor na temu

ivangeta
Ivan Mihajlović
IT Menager & Network Administrator
Negotin

Član broj: 153906
Poruke: 8
91.150.126.*

Sajt: www.ivanm.tk

Profil

Re: [Excel] Konvertovanje Macro Modula iz Excela u Open office

^{03.05.2008. u 07:52 - pre 194 meseci}

Evo rešenja kako da postavite makro za openoffice 2.x da vam konvertuje brojeve u slova !!! Uživajte

Iskopirajte ove kodove u predhodno otvoren prozor makroa :

Code:

Function slovima(broj)

If broj = 0 Then rez = "nula"

ReDim imebr(9)
imebr(1) = "jedan"
imebr(2) = "dva"
imebr(3) = "tri"
imebr(4) = "četri"
imebr(5) = "pet"
imebr(6) = "šest"
imebr(7) = "sedam"
imebr(8) = "osam"
imebr(9) = "devet"

rez = ""
celi = Int(broj)
dec = ((broj - celi) * 100) Mod 100
cbr = Str(celi)
duzina = 16 - Len(cbr)
cBroj = String(duzina, "0") & Right(cbr, Len(cbr) - 1)

i = 1

Do While i < 15
tric = Mid(cBroj, i, 3)
trojka = Val(tric)
If tric <> "000" Then
  cs = Val(Mid(tric, 1, 1))
  cd = Val(Mid(tric, 2, 1))
  cj = Val(Mid(tric, 3, 1))
  Select Case cs
   Case 2
    rez = rez & "dve"
   Case Is > 2
    rez = rez & imebr(cs)
  End Select

  Select Case cs
   Case 1
    rez = rez & "stotinu"
   Case 2, 3, 4
    rez = rez & "stotine"
   Case Is > 4
    rez = rez & "stotina"
  End Select

  If cj = 0 Then sl1 = "" Else sl1 = imebr(cj)

  Select Case cd
   Case 4
    rez = rez & "četr"
   Case 6
    rez = rez & "šez"
   Case 5
    rez = rez & "pe"
   Case 9
    rez = rez & "deve"
   Case 2, 3, 7, 8
    rez = rez & imebr(cd)
   Case 1
    sl1 = ""
    Select Case cj
     Case 0
      rez = rez & "deset"
     Case 1
      rez = rez & "jeda"
     Case 4
      rez = rez & "četr"
     Case Else
      rez = rez & imebr(cj)
    End Select
   If cj > 0 Then rez = rez & "naest"
  End Select

  If cd > 1 Then rez = rez & "deset"

  If (i = 4 Or i = 10) And cd <> 1 Then
   If cj = 1 Then
    sl1 = "jedna"
   ElseIf cj = 2 Then
    sl1 = "dve"
   End If
  End If

  rez = rez & sl1

  Select Case i

   Case 1
    rez = rez & "bilion"
    If cj > 1 Or cd = 1 Then rez = rez & "a"

   Case 4
    rez = rez & "milijard"
    If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Then
     rez = rez & "i"
    ElseIf cj = 1 Then
     rez = rez & "a"
    ElseIf cj > 4 Or cj = 0 Then
     rez = rez & "i"
    ElseIf cj > 1 Then
     rez = rez & "e"
    End If

   Case 7
    rez = rez & "milion"
    If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj <> 1 Then
     rez = rez & "a"
    End If

   Case 10
    rez = rez & "hiljad"
    If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj = 1 Then
     rez = rez & "a"
    ElseIf trojka = 1 Then
     rez = rez & "u"
    ElseIf cj > 4 Or cj = 0 Then
     rez = rez & "a"
    ElseIf cj > 1 Then
     rez = rez & "e"
    End If

  End Select
End If
i = i + 3
Loop
rez = UCase(Left(rez, 1)) & Right(rez, Len(rez) - 1)
slovima = "Slovima fakturni iznos : " & rez  & "  dinara i " & Str(dec) & "/00" & " para"

End Function

I to je to radi ko sat.....garantovano i provereno !!! Nadam se da sam vam pomogao pošto meni niko nije znao kako da izmenja postojećue kodove pa sam morao sam opet da zavrnem rukave !!!

edit by Ivek33 - uređenje poruke

_{[Ovu poruku je menjao Ivek33 dana 03.05.2008. u 09:09 GMT+1]}

Odgovor na temu