[es] - Automatsko pretvaranje latiničnih karaktera u ćirilične

Shadow Hunter
Dalibor Veljković
Krusevac

Član broj: 8844
Poruke: 46
*.dynamic.sbb.rs.

+1 Profil

Automatsko pretvaranje latiničnih karaktera u ćirilične

^{17.09.2013. u 22:31 - pre 141 meseci}

Ako Vam je dosadilo da koristite razne dodatke za konverzuju, u radnoj svesci u VB editoru idite na opciju Insert Module i ubacite sledeći kod:

Function StripAccent(thestring As String)

Dim A As String * 1
Dim B As String * 1
Dim i As Integer

Const accchars = "ABVGDĐEŽZIJKLMNOPRSTĆUFHCČŠabvgdđežzijklmnoprstćufhcčš"
regchars = ChrW(1040) + ChrW(1041) + ChrW(1042) + ChrW(1043) + ChrW(1044) + ChrW(1026) + ChrW(1045) + ChrW(1046) + ChrW(1047) + ChrW(1048) + ChrW(1032) + ChrW(1050) + ChrW(1051) + ChrW(1052) + ChrW(1053) + ChrW(1054) + ChrW(1055) + ChrW(1056) + ChrW(1057) + ChrW(1058) + ChrW(1035) + ChrW(1059) + ChrW(1060) + ChrW(1061) + ChrW(1062) + ChrW(1063) + ChrW(1064) + ChrW(1072) + ChrW(1073) + ChrW(1074) + ChrW(1075) + ChrW(1076) + ChrW(1106) + ChrW(1077) + ChrW(1078) + ChrW(1079) + ChrW(1080) + ChrW(1112) + ChrW(1082) + ChrW(1083) + ChrW(1084) + ChrW(1085) + ChrW(1086) + ChrW(1087) + ChrW(1088) + ChrW(1089) + ChrW(1090) + ChrW(1115) + ChrW(1091) + ChrW(1092) + ChrW(1093) + ChrW(1094) + ChrW(1095) + ChrW(1096)

For i = 1 To Len(accchars)
A = Mid(accchars, i, 1)
B = Mid(regchars, i, 1)
thestring = Replace(thestring, "Dj", ChrW(1026))
thestring = Replace(thestring, "DJ", ChrW(1026))
thestring = Replace(thestring, "dj", ChrW(1106))
thestring = Replace(thestring, "Lj", ChrW(1033))
thestring = Replace(thestring, "LJ", ChrW(1033))
thestring = Replace(thestring, "lj", ChrW(1113))
thestring = Replace(thestring, "Nj", ChrW(1034))
thestring = Replace(thestring, "NJ", ChrW(1034))
thestring = Replace(thestring, "nj", ChrW(1114))
thestring = Replace(thestring, "Dž", ChrW(1039))
thestring = Replace(thestring, "DŽ", ChrW(1039))
thestring = Replace(thestring, "dž", ChrW(1119))
thestring = Replace(thestring, A, B)
Next
StripAccent = thestring

End Function

Funkcija se poziva kada na primer u polju B1 otkucate funkciju =StripAccent(A1)
Svaki tekst koji se nalazi u polju A1 biće pretvoren u ćirilicu.

Ovo sam napravio silom prilika, a ako nekog ne mrzi ili mu treba može napraviti modul za suprotnu konverziju ili konverziju iz YUSCII koda u latinicu, ćirilicu...
Pošto VB za Excel ne podržava našu ćirilicu potrebno je pronaći ispravne ChrW kodove.

Ideja za kod nije baš moja već je služila za konverziju nekih ruskih karatkera u englesku latinicu, pa sam je "malo" promenio.

Provereno radi bez greške na Excel-u 2010 i 2013, a ako tekst sadrži Dj, DJ ili Đ, modul ga pretvara u odgovarajući ćirilični znak.

Pozdrav svima!!!

Fajl sa ugrađenim modulom:
http://www.sendspace.com/file/45qszl

_{[Ovu poruku je menjao Shadow Hunter dana 18.09.2013. u 22:37 GMT+1]}

No light, No shadows...

Odgovor na temu