program za konvertovanje latinice u ćirilicu - transliteracija (preslovljavanje)

8

program za konvertovanje latinice u ćirilicu - transliteracija (preslovljavanje)

offline
  • Pridružio: 17 Jun 2012
  • Poruke: 1

kako da skinem konverziju latinica ćirilica za office 2010



Registruj se da bi učestvovao u diskusiji. Registrovanim korisnicima se NE prikazuju reklame unutar poruka.
offline
  • Pridružio: 19 Feb 2007
  • Poruke: 1794

Sa ovog linka.



offline
  • Pridružio: 24 Avg 2014
  • Poruke: 29

Postovani,
i ja imam isti problem instalirala sam ovaj Vas YuConvNet.zip ,ali se nista ne desava.

offline
  • Pridružio: 06 Maj 2007
  • Poruke: 241
  • Gde živiš: Beograd

Napisano: 28 Maj 2015 17:51

To sam davno uradio, za YUSCII kodnu stranu u cirilicu 1251. Prepravi za svoje potrebe.
U VBA koristis komandu ChrW$ koja omogucava da se ispise ascii kod veci od 255, sto chr$ ne moze vec ispisuje karaktere do ascii koda 255.

The valid range for Chr is 0 through 255, and the valid range for ChrW is -32768 through 65535.

Evo koda:

If TipKonverzijeKodneStrane = 4 Then
        'Konvertovanje iz kodne strane YUSCII u Serbian(Cirilic, Serbia) 1251
        For n = 1 To Len(Tekst)
       
        'Mala slova
           
            'Velika slova
            If Asc(Mid(Tekst, n, 1)) = 13 Then
                novitekst = novitekst & Chr(Asc(Mid(Tekst, n, 1)))
            End If
                       
           
            If Asc(Mid(Tekst, n, 1)) > 31 And Asc(Mid(Tekst, n, 1)) < 47 Then
               
                novitekst = novitekst & Chr(Asc(Mid(Tekst, n, 1)))
            End If
            If Asc(Mid(Tekst, n, 1)) > 47 And Asc(Mid(Tekst, n, 1)) < 64 Then
               
                novitekst = novitekst & Chr(Asc(Mid(Tekst, n, 1)))
            End If
           
            If Mid(Tekst, n, 1) = "_" Then
                novitekst = novitekst & Chr(95)
            End If
           
            If Mid(Tekst, n, 1) = "A" Then
                novitekst = novitekst & ChrW$(1040)
            End If
            If Mid(Tekst, n, 1) = "B" Then
                novitekst = novitekst & ChrW$(1041)
            End If
            If Mid(Tekst, n, 1) = "V" Then
                novitekst = novitekst & ChrW$(1042)
            End If
            If Mid(Tekst, n, 1) = "G" Then
                novitekst = novitekst & ChrW$(1043)
            End If
            If Mid(Tekst, n, 1) = "D" Then
                novitekst = novitekst & ChrW$(1044)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "\" Then
                novitekst = novitekst & ChrW$(1026)
            End If
            '''''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "E" Then
                novitekst = novitekst & ChrW$(1045)
            End If
            If Mid(Tekst, n, 1) = "@" Then
                novitekst = novitekst & ChrW$(1046)
            End If
            If Mid(Tekst, n, 1) = "Z" Then
                novitekst = novitekst & ChrW$(1047)
            End If
            If Mid(Tekst, n, 1) = "I" Then
                novitekst = novitekst & ChrW$(1048)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "J" Then
                novitekst = novitekst & ChrW$(1032)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "K" Then
                novitekst = novitekst & ChrW$(1050)
            End If
            If Mid(Tekst, n, 1) = "L" Then
                novitekst = novitekst & ChrW$(1051)
            End If
            ''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "Q" Then
                novitekst = novitekst & ChrW$(1033)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "M" Then
                novitekst = novitekst & ChrW$(1052)
            End If
            If Mid(Tekst, n, 1) = "N" Then
                novitekst = novitekst & ChrW$(1053)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "W" Then
                novitekst = novitekst & ChrW$(1034)
            End If
            '''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "O" Then
                novitekst = novitekst & ChrW$(1054)
            End If
            If Mid(Tekst, n, 1) = "P" Then
                novitekst = novitekst & ChrW$(1055)
            End If
            If Mid(Tekst, n, 1) = "R" Then
                novitekst = novitekst & ChrW$(1056)
            End If
            If Mid(Tekst, n, 1) = "S" Then
                novitekst = novitekst & ChrW$(1057)
            End If
            If Mid(Tekst, n, 1) = "T" Then
                novitekst = novitekst & ChrW$(1058)
            End If
            '''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "]" Then
                novitekst = novitekst & ChrW$(1035)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "U" Then
                novitekst = novitekst & ChrW$(1059)
            End If
            If Mid(Tekst, n, 1) = "F" Then
                novitekst = novitekst & ChrW$(1060)
            End If
            If Mid(Tekst, n, 1) = "H" Then
                novitekst = novitekst & ChrW$(1061)
            End If
            If Mid(Tekst, n, 1) = "C" Then
                novitekst = novitekst & ChrW$(1062)
            End If
            If Mid(Tekst, n, 1) = "^" Then
                novitekst = novitekst & ChrW$(1063)
            End If
            '''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "X" Then
                novitekst = novitekst & ChrW$(1039)
            End If
            '''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "[" Then
                novitekst = novitekst & ChrW$(1064)
            End If
         
'           Mala slova
            If Mid(Tekst, n, 1) = "a" Then
                novitekst = novitekst & ChrW$(1072)
            End If
            If Mid(Tekst, n, 1) = "b" Then
                novitekst = novitekst & ChrW$(1073)
            End If
            If Mid(Tekst, n, 1) = "v" Then
                novitekst = novitekst & ChrW$(1074)
            End If
            If Mid(Tekst, n, 1) = "g" Then
                novitekst = novitekst & ChrW$(1075)
            End If
            If Mid(Tekst, n, 1) = "d" Then
                novitekst = novitekst & ChrW$(1076)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "|" Then
                novitekst = novitekst & ChrW$(1106)
            End If
            '''''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "e" Then
                novitekst = novitekst & ChrW$(1077)
            End If
            If Mid(Tekst, n, 1) = "`" Then
                novitekst = novitekst & ChrW$(1078)
            End If
            If Mid(Tekst, n, 1) = "z" Then
                novitekst = novitekst & ChrW$(1079)
            End If
            If Mid(Tekst, n, 1) = "i" Then
                novitekst = novitekst & ChrW$(1080)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "j" Then
                novitekst = novitekst & ChrW$(1112)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "k" Then
                novitekst = novitekst & ChrW$(1082)
            End If
            If Mid(Tekst, n, 1) = "l" Then
                novitekst = novitekst & ChrW$(1083)
            End If
            ''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "q" Then
                novitekst = novitekst & ChrW$(1113)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "m" Then
                novitekst = novitekst & ChrW$(1084)
            End If
            If Mid(Tekst, n, 1) = "n" Then
                novitekst = novitekst & ChrW$(1085)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "w" Then
                novitekst = novitekst & ChrW$(1114)
            End If
            '''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "o" Then
                novitekst = novitekst & ChrW$(1086)
            End If
            If Mid(Tekst, n, 1) = "p" Then
                novitekst = novitekst & ChrW$(1087)
            End If
            If Mid(Tekst, n, 1) = "r" Then
                novitekst = novitekst & ChrW$(1088)
            End If
            If Mid(Tekst, n, 1) = "s" Then
                novitekst = novitekst & ChrW$(1089)
            End If
            If Mid(Tekst, n, 1) = "t" Then
                novitekst = novitekst & ChrW$(1090)
            End If
            '''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "}" Then
                novitekst = novitekst & ChrW$(1115)
            End If
            ''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "u" Then
                novitekst = novitekst & ChrW$(1091)
            End If
            If Mid(Tekst, n, 1) = "f" Then
                novitekst = novitekst & ChrW$(1092)
            End If
            If Mid(Tekst, n, 1) = "h" Then
                novitekst = novitekst & ChrW$(1093)
            End If
            If Mid(Tekst, n, 1) = "c" Then
                novitekst = novitekst & ChrW$(1094)
            End If
            If Mid(Tekst, n, 1) = "~" Then
                novitekst = novitekst & ChrW$(1095)
            End If
            '''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "x" Then
                novitekst = novitekst & ChrW$(1119)
            End If
            '''''''''''''''''''''''''''''''''
            If Mid(Tekst, n, 1) = "{" Then
                novitekst = novitekst & ChrW$(1096)
            End If


Dopuna: 28 Maj 2015 18:00

Evo vam macro za preslovljavanje u Wordu iz cirilice u latinicu sa upustvom i druge konverzije...
https://www.mycity.rs/must-login.png

Dopuna: 07 Jun 2015 22:55

Evo Makro by VRACKO (1995) Latinicno cirilicni konvertor za Word,
posto je to trazeno:


Attribute VB_Name = "LatToCir"

Rem *****************************************************
Rem *                                                   *
Rem *          Makro by VRACKO (1995)                   *
Rem *          Latinicno cirilicni konvertor            *
Rem *                                                   *
Rem *  Opciju za konvertovanje samo selektovanog dela   *
Rem *  teksta (12/04/2001), konvertovanje u headerima   *
Rem *  i footerima (24/04/2001), konvertovanje u        *
Rem *  futnotama, endnotama i komentarima (01/05/2001)  *
Rem *  dodao Sasa Babic                                 *
Rem *                                                   *
Rem *****************************************************
Dim TriSlovaLat(3) As String
Dim TriSlovaCir(3) As String
Dim Lat(60) As String
Dim Cir(60) As String


Public Sub CirToLat()

On Error GoTo greska

TriSlovaLat(0) = "LJ": TriSlovaLat(1) = "NJ": TriSlovaLat(2) = "D" + ChrW$(381)

TriSlovaCir(0) = ChrW$(1033): TriSlovaCir(1) = ChrW$(1034): TriSlovaCir(2) = ChrW$(1039)

Lat(0) = ChrW$(76) + ChrW$(106): Lat(1) = ChrW$(78) + ChrW$(106): _
Lat(2) = ChrW$(68) + ChrW$(382): Lat(3) = ChrW$(108) + ChrW$(106): _
Lat(4) = ChrW$(110) + ChrW$(106): Lat(5) = ChrW$(100) + ChrW$(382): _
Lat(6) = ChrW$(65): Lat(7) = ChrW$(66): Lat(8) = ChrW$(86): Lat(9) = ChrW$(71) _
: Lat(10) = ChrW$(68): Lat(11) = ChrW$(272): Lat(12) = ChrW$(69): Lat(13) = ChrW$(381) _
: Lat(14) = ChrW$(90): Lat(15) = ChrW$(73): Lat(16) = ChrW$(74): Lat(17) = ChrW$(75) _
: Lat(18) = ChrW$(76): Lat(19) = ChrW$(77): Lat(20) = ChrW$(78): Lat(21) = ChrW$(79) _
: Lat(22) = ChrW$(80): Lat(23) = ChrW$(82): Lat(24) = ChrW$(83): Lat(25) = ChrW$(84) _
: Lat(26) = ChrW$(262): Lat(27) = ChrW$(85): Lat(28) = ChrW$(70): Lat(29) = ChrW$(72) _
: Lat(30) = ChrW$(67): Lat(31) = ChrW$(268): Lat(32) = ChrW$(352): Lat(33) = ChrW$(97) _
: Lat(34) = ChrW$(98): Lat(35) = ChrW$(118): Lat(36) = ChrW$(103): Lat(37) = ChrW$(100) _
: Lat(38) = ChrW$(273): Lat(39) = ChrW$(101): Lat(40) = ChrW$(382): Lat(41) = ChrW$(122) _
: Lat(42) = ChrW$(105): Lat(43) = ChrW$(106): Lat(44) = ChrW$(107): Lat(45) = ChrW$(108) _
: Lat(46) = ChrW$(109): Lat(47) = ChrW$(110): Lat(48) = ChrW$(111): Lat(49) = ChrW$(112) _
: Lat(50) = ChrW$(114): Lat(51) = ChrW$(115): Lat(52) = ChrW$(116): Lat(53) = ChrW$(263) _
: Lat(54) = ChrW$(117): Lat(55) = ChrW$(102): Lat(56) = ChrW$(104): Lat(57) = ChrW$(99) _
: Lat(58) = ChrW$(269): Lat(59) = ChrW$(353)

Cir(0) = ChrW$(1033): Cir(1) = ChrW$(1034): Cir(2) = ChrW$(1039): Cir(3) = ChrW$(1113) _
: Cir(4) = ChrW$(1114): Cir(5) = ChrW$(1119): Cir(6) = ChrW$(1040): Cir(7) = ChrW$(1041) _
: Cir(8) = ChrW$(1042): Cir(9) = ChrW$(1043): Cir(10) = ChrW$(1044): Cir(11) = ChrW$(1026) _
: Cir(12) = ChrW$(1045): Cir(13) = ChrW$(1046): Cir(14) = ChrW$(1047): Cir(15) = ChrW$(1048): Cir(16) = ChrW$(1032): Cir(17) = ChrW$(1050): Cir(18) = ChrW$(1051): Cir(19) = ChrW$(1052) _
: Cir(20) = ChrW$(1053): Cir(21) = ChrW$(1054): Cir(22) = ChrW$(1055): Cir(23) = ChrW$(1056) _
: Cir(24) = ChrW$(1057): Cir(25) = ChrW$(1058): Cir(26) = ChrW$(1035): Cir(27) = ChrW$(1059) _
: Cir(28) = ChrW$(1060): Cir(29) = ChrW$(1061): Cir(30) = ChrW$(1062): Cir(31) = ChrW$(1063) _
: Cir(32) = ChrW$(1064): Cir(33) = ChrW$(1072): Cir(34) = ChrW$(1073): Cir(35) = ChrW$(1074) _
: Cir(36) = ChrW$(1075): Cir(37) = ChrW$(1076): Cir(38) = ChrW$(1106): Cir(39) = ChrW$(1077) _
: Cir(40) = ChrW$(1078): Cir(41) = ChrW$(1079): Cir(42) = ChrW$(1080): Cir(43) = ChrW$(1112) _
: Cir(44) = ChrW$(1082): Cir(45) = ChrW$(1083): Cir(46) = ChrW$(1084): Cir(47) = ChrW$(1085) _
: Cir(48) = ChrW$(1086): Cir(49) = ChrW$(1087): Cir(50) = ChrW$(1088): Cir(51) = ChrW$(1089) _
: Cir(52) = ChrW$(1090): Cir(53) = ChrW$(1115): Cir(54) = ChrW$(1091): Cir(55) = ChrW$(1092) _
: Cir(56) = ChrW$(1093): Cir(57) = ChrW$(1094): Cir(58) = ChrW$(1095): Cir(59) = ChrW$(1096)

Klik = 0

LatToCirForm.CommandButton1.Caption = "Latinica->" + ChrW$(1035) + ChrW$(1080) + ChrW$(1088) _
+ ChrW$(1080) + ChrW$(1083) + ChrW$(1080) + ChrW$(1094) + ChrW$(1072)

LatToCirForm.CommandButton2.Caption = ChrW$(1035) + ChrW$(1080) + ChrW$(1088) _
+ ChrW$(1080) + ChrW$(1083) + ChrW$(1080) + ChrW$(1094) + ChrW$(1072) + "->Latinica"

LatToCirForm.Show

Set pozicija = Selection.Range
tipprozora = ActiveDocument.ActiveWindow.View.Type
Application.ScreenUpdating = False

Application.ScreenUpdating = False

If Selection.Range.Start <> Selection.Range.End Then
    CirLat
   
Else
    Selection.HomeKey Unit:=wdStory, Extend:=wdMove
    CirLat
   
    For Each oblik In ActiveDocument.Shapes
        If oblik.TextFrame.HasText Then
            oblik.TextFrame.TextRange.Select
            CirLat
        Else
        End If
    Next
   
    For Each sekc In ActiveDocument.Sections
        For Each heder In sekc.Headers
            heder.Range.Select
            If Len(Selection.Range.Text) > 1 Then
                CirLat
            End If
        Next
        For Each futer In sekc.Footers
            futer.Range.Select
            If Len(Selection.Range.Text) > 1 Then
                CirLat
            End If
        Next
    Next
   
    For Each oblik In Selection.HeaderFooter.Shapes
        If oblik.TextFrame.HasText Then
            oblik.TextFrame.TextRange.Select
            CirLat
        End If
    Next

    For Each fusnota In ActiveDocument.Footnotes
        fusnota.Range.Select
        CirLat
    Next

    For Each endnota In ActiveDocument.Endnotes
        endota.Range.Select
        CirLat
    Next
   
    For Each komentar In ActiveDocument.Comments
        komentar.Range.Select
        CirLat
    Next
   
    If ActiveWindow.Panes.Count > 1 Then
        ActiveWindow.ActivePane.Close
    End If
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = tipprozora
    Else
        ActiveWindow.View.Type = tipprozora
    End If
End If

pozicija.Select
Application.ScreenUpdating = True

kraj:
Exit Sub

greska:
MsgBox Err.Description, vbExclamation, "Greska: " & Err.Number
GoTo kraj

End Sub

Public Sub CirLat()

iz = LatToCirForm.Klik
If iz = 1 Then
    For x = 0 To 2
        Selection.Find.Execute FindText:=TriSlovaLat(x), MatchCase:=True, ReplaceWith:=TriSlovaCir(x), _
        Replace:=wdReplaceAll
    Next
    For x = 0 To 59
        Selection.Find.Execute FindText:=Lat(x), MatchCase:=True, ReplaceWith:=Cir(x), _
        Replace:=wdReplaceAll
    Next
Else
    For x = 0 To 59
        Selection.Find.Execute FindText:=Cir(x), MatchCase:=True, ReplaceWith:=Lat(x), _
        Replace:=wdReplaceAll
    Next
End If

End Sub

offline
  • Pridružio: 14 Feb 2015
  • Poruke: 9

mycity.rs/Windows-Download/Latinica-u-C.....ertor.html

offline
  • jojke 
  • Novi MyCity građanin
  • Pridružio: 30 Avg 2015
  • Poruke: 2

Problem?

Excel 2003

Latinica->ćirilica preko celog radnog lista ne radi
Tj. radi delimično (tekstualna polja radi dobro, ali kada naiđe na funkciju =sum(a1: a3), konverter prevede i sum u сум i ode mas' u propast)

Rešenje problema je?:

Nemojte da mi preporučite da pređem na excel - 2007 i noviji!

Hvala na pomoći.

Ko je trenutno na forumu
 

Ukupno su 923 korisnika na forumu :: 56 registrovanih, 6 sakrivenih i 861 gosta   ::   [ Administrator ] [ Supermoderator ] [ Moderator ] :: Detaljnije

Najviše korisnika na forumu ikad bilo je 3466 - dana 01 Jun 2021 17:07

Korisnici koji su trenutno na forumu:
Korisnici trenutno na forumu: 357magnum, _Petar, A.R.Chafee.Jr., Alibaba1981, amaterSRB, arzak, bojcistv, bufanje, crnitrn, darkojbn, dejanbenkovic, Denaya, djboj, djordje92sm, dragoljub11987, esx66, FOX, goxin, hyla, Istman, ivica976, JOntra, laki_bb, Lieutenant, Lucije Kvint, manda87, Mercury, mile23, Milos ZA, misaru, Miskohd, mkukoleca, mnn2, moldway, mushroom, opt1, Outis, panonski mornar, procesor, promajauglavi, pvoman, Regrut Boskica, Rocker, segax1, shone34, stegonosa, Tas011, tubular, vathra, Vatrogasaccc, VJ, vranjanac29, vsn111, wizzardone, zoranis, Živković