Created
October 24, 2025 08:10
-
-
Save shantanuo/5f680cda45ecb3749a3904a738208090 to your computer and use it in GitHub Desktop.
macro to convert krutidev to Unicode
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| original string: | |
| izFke Js.kh] | |
| ¼U;k- dz- 6½] vdksyk- | |
| expected string: | |
| प्रथम श्रेणी, | |
| (न्या. क्र. ६), अकोला. | |
| _____ | |
| Sub ConvertSelection_KrutiToUnicode | |
| Dim oDoc As Object, oSel As Object, oCursor As Object | |
| Dim inputText As String, outputText As String | |
| oDoc = ThisComponent | |
| oSel = oDoc.CurrentSelection | |
| If oSel.getCount() = 0 Then | |
| MsgBox "Please select some text first." | |
| Exit Sub | |
| End If | |
| oCursor = oSel.getByIndex(0) | |
| inputText = oCursor.getString() | |
| outputText = KrutiToUnicodeText(inputText) | |
| oCursor.setString(outputText) | |
| End Sub | |
| Function KrutiToUnicodeText(inputText As String) As String | |
| Dim kruti() As String, uni() As String | |
| Dim kruti_punc() As String, uni_punc() As String | |
| Dim i As Integer, token As String, outputText As String | |
| Dim tokens() As String | |
| ' --- Initialize arrays --- | |
| kruti = Split("iz,Fk,e,Js,.kh,U;k,dz,v,dks,yk", ",") | |
| uni = Split("प्र,थ,म,श्रे,णी,न्या,क्र,अ,को,ला", ",") | |
| ' Explicitly ReDim punctuation arrays to avoid "object variable" error | |
| ReDim kruti_punc(3) | |
| ReDim uni_punc(3) | |
| kruti_punc(0) = "]" | |
| kruti_punc(1) = "¼" | |
| kruti_punc(2) = "½" | |
| kruti_punc(3) = "-" | |
| uni_punc(0) = "," | |
| uni_punc(1) = "(" | |
| uni_punc(2) = ")" | |
| uni_punc(3) = "." | |
| tokens = SplitWithSpaces(inputText) | |
| For Each token In tokens | |
| If IsSpaceOnly(token) Then | |
| outputText = outputText & token | |
| Else | |
| outputText = outputText & KrutiToUnicodeWord(token, kruti, uni, kruti_punc, uni_punc) | |
| End If | |
| Next token | |
| KrutiToUnicodeText = outputText | |
| End Function | |
| Function KrutiToUnicodeWord(word As String, kruti() As String, uni() As String, kruti_punc() As String, uni_punc() As String) As String | |
| Dim prefix As String, suffix As String | |
| Dim i As Integer, tempWord As String | |
| Dim changed As Boolean | |
| tempWord = word | |
| ' --- Handle all leading punctuation --- | |
| Do | |
| changed = False | |
| For i = LBound(kruti_punc) To UBound(kruti_punc) | |
| If Left(tempWord, Len(kruti_punc(i))) = kruti_punc(i) Then | |
| prefix = prefix & uni_punc(i) | |
| tempWord = Mid(tempWord, Len(kruti_punc(i)) + 1) | |
| changed = True | |
| Exit For | |
| End If | |
| Next i | |
| Loop While changed | |
| ' --- Handle all trailing punctuation --- | |
| Do | |
| changed = False | |
| For i = LBound(kruti_punc) To UBound(kruti_punc) | |
| If Right(tempWord, Len(kruti_punc(i))) = kruti_punc(i) Then | |
| suffix = uni_punc(i) & suffix | |
| tempWord = Left(tempWord, Len(tempWord) - Len(kruti_punc(i))) | |
| changed = True | |
| Exit For | |
| End If | |
| Next i | |
| Loop While changed | |
| ' --- Replace Kruti patterns (longest first) --- | |
| Dim order() As Integer | |
| order = SortByLengthDesc(kruti) | |
| For i = LBound(order) To UBound(order) | |
| tempWord = Replace(tempWord, kruti(order(i)), uni(order(i))) | |
| Next i | |
| KrutiToUnicodeWord = prefix & tempWord & suffix | |
| End Function | |
| ' --- Helper: sort index by string length descending --- | |
| Function SortByLengthDesc(arr() As String) As Variant | |
| Dim i As Integer, j As Integer, n As Integer, temp As Integer | |
| n = UBound(arr) | |
| Dim idx() As Integer | |
| ReDim idx(n) | |
| For i = 0 To n | |
| idx(i) = i | |
| Next i | |
| For i = 0 To n - 1 | |
| For j = i + 1 To n | |
| If Len(arr(idx(i))) < Len(arr(idx(j))) Then | |
| temp = idx(i) | |
| idx(i) = idx(j) | |
| idx(j) = temp | |
| End If | |
| Next j | |
| Next i | |
| SortByLengthDesc = idx | |
| End Function | |
| ' --- Helper: Split text preserving spaces --- | |
| Function SplitWithSpaces(text As String) As Variant | |
| Dim result() As String | |
| Dim i As Long, ch As String | |
| Dim mode As String, count As Long | |
| ReDim result(0) | |
| For i = 1 To Len(text) | |
| ch = Mid(text, i, 1) | |
| If ch = " " Or ch = Chr(9) Or ch = Chr(10) Then | |
| If mode <> "space" Then | |
| count = count + 1 | |
| ReDim Preserve result(count) | |
| result(count) = "" | |
| mode = "space" | |
| End If | |
| result(count) = result(count) & ch | |
| Else | |
| If mode <> "word" Then | |
| count = count + 1 | |
| ReDim Preserve result(count) | |
| result(count) = "" | |
| mode = "word" | |
| End If | |
| result(count) = result(count) & ch | |
| End If | |
| Next i | |
| SplitWithSpaces = result | |
| End Function | |
| ' --- Helper: Check if token is only spaces --- | |
| Function IsSpaceOnly(s As String) As Boolean | |
| Dim i As Long, ch As String | |
| For i = 1 To Len(s) | |
| ch = Mid(s, i, 1) | |
| If ch <> " " And ch <> Chr(9) And ch <> Chr(10) Then | |
| IsSpaceOnly = False | |
| Exit Function | |
| End If | |
| Next i | |
| IsSpaceOnly = True | |
| End Function | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment