[es] - Procedura radi pod Access '97 ali ne i pod Access 2000, pomoc?

djape_ns
Predrag Kovacevic
Novi Sad

Član broj: 28891
Poruke: 9
193.203.11.*

Profil

Re: Procedura radi pod Access '97 ali ne i pod Access 2000, pomoc?

^{13.07.2004. u 07:43 - pre 240 meseci}

Evo kod:

Function Konv_cir(Optional Podatak As String)
'============================================================='
' Radi konverziju formatizovanog teksta (Podatak) u odredjeni font

Dim cPodatak As String

cPodatak = replace(Podatak, "B", ChrW(193))
cPodatak = replace(cPodatak, "b", ChrW(225))
cPodatak = replace(cPodatak, "V", ChrW(194))
cPodatak = replace(cPodatak, "v", ChrW(226))
cPodatak = replace(cPodatak, "G", ChrW(195))
cPodatak = replace(cPodatak, "g", ChrW(227))
cPodatak = replace(cPodatak, "DŽ", ChrW(143))
cPodatak = replace(cPodatak, "Dž", ChrW(143))
cPodatak = replace(cPodatak, "dž", ChrW(376))
cPodatak = replace(cPodatak, "D", ChrW(196))
cPodatak = replace(cPodatak, "d", ChrW(228))
cPodatak = replace(cPodatak, "Đ", ChrW(8364))
cPodatak = replace(cPodatak, "đ", ChrW(144))
cPodatak = replace(cPodatak, "Ž", ChrW(198))
cPodatak = replace(cPodatak, "ž", ChrW(230))
cPodatak = replace(cPodatak, "Z", ChrW(199))
cPodatak = replace(cPodatak, "z", ChrW(231))
cPodatak = replace(cPodatak, "(I)", ChrW(49))
cPodatak = replace(cPodatak, "II", ChrW(50))
cPodatak = replace(cPodatak, "III", ChrW(51))
cPodatak = replace(cPodatak, "I", ChrW(200))
cPodatak = replace(cPodatak, "i", ChrW(232))
cPodatak = replace(cPodatak, "k", ChrW(234))
cPodatak = replace(cPodatak, "Š", ChrW(216))
cPodatak = replace(cPodatak, "š", ChrW(248))
cPodatak = replace(cPodatak, "LJ", ChrW(352))
cPodatak = replace(cPodatak, "Lj", ChrW(352))
cPodatak = replace(cPodatak, "lj", ChrW(353))
cPodatak = replace(cPodatak, "L", ChrW(203))
cPodatak = replace(cPodatak, "l", ChrW(235))
cPodatak = replace(cPodatak, "m", ChrW(236))
cPodatak = replace(cPodatak, "NJ", ChrW(338))
cPodatak = replace(cPodatak, "Nj", ChrW(338))
cPodatak = replace(cPodatak, "nj", ChrW(339))
cPodatak = replace(cPodatak, "N", ChrW(205))
cPodatak = replace(cPodatak, "n", ChrW(237))
cPodatak = replace(cPodatak, "P", ChrW(207))
cPodatak = replace(cPodatak, "p", ChrW(239))
cPodatak = replace(cPodatak, "R", ChrW(208))
cPodatak = replace(cPodatak, "r", ChrW(240))
cPodatak = replace(cPodatak, "S", ChrW(209))
cPodatak = replace(cPodatak, "s", ChrW(241))
cPodatak = replace(cPodatak, "t", ChrW(242))
cPodatak = replace(cPodatak, "Ć", ChrW(381))
cPodatak = replace(cPodatak, "ć", ChrW(382))
cPodatak = replace(cPodatak, "U", ChrW(211))
cPodatak = replace(cPodatak, "u", ChrW(243))
cPodatak = replace(cPodatak, "F", ChrW(212))
cPodatak = replace(cPodatak, "f", ChrW(244))
cPodatak = replace(cPodatak, "H", ChrW(213))
cPodatak = replace(cPodatak, "h", ChrW(245))
cPodatak = replace(cPodatak, "C", ChrW(214))
cPodatak = replace(cPodatak, "c", ChrW(246))
cPodatak = replace(cPodatak, "Č", ChrW(215))
cPodatak = replace(cPodatak, "č", ChrW(247))
cPodatak = replace(cPodatak, " ", ChrW(160))

Konv_cir = cPodatak

End Function

Function replace(ByVal Text As String, Sta As String, Sa_cim As String) As String

Dim Start As Integer
Dim tempstr1 As String, tempstr2 As String

Start = 1
If Len(Sta) = 1 Then
Do While InStr(Start, Text, Sta, 0) <> 0
Start = InStr(Start, Text, Sta, 0)
Mid$(Text, Start, 1) = Sa_cim
Start = Start + 1
Loop
replace = Text

ElseIf Len(Sta) = 2 Then

Do While InStr(Start, Text, Sta, 0) <> 0
Start = InStr(1, Text, Sta, vbBinaryCompare)
tempstr1 = Mid$(Text, 1, Start - 1)
tempstr2 = Mid$(Text, Start + 2)
Text = tempstr1 & Sa_cim & tempstr2
Loop
replace = Text

ElseIf Len(Sta) = 3 Then

Do While InStr(Start, Text, Sta, 0) <> 0
Start = InStr(1, Text, Sta, vbBinaryCompare)
tempstr1 = Mid$(Text, 1, Start - 1)
tempstr2 = Mid$(Text, Start + 3)
Text = tempstr1 & Sa_cim & tempstr2
Loop
replace = Text

End If

End Function

Odgovor na temu