Μετατροπή Ελληνικών σε γκρίκλις / Greeklish στο Word

Μεγάλη συζήτηση γίνεται (ξανά) αυτές τις ημέρες στην τηλεόραση και στο δίκτυο για το αν τα  γκρίκλις / Greeklish  συνιστούν απειλή για τη γλώσσα μας.  Προσωπικά πιστεύω ότι για ένα σύντομο μήνυμα 2-3 γραμμών δεν αποτελούν πρόβλημα αλλά για ένα μεγαλύτερο κείμενο, τα γκρίκλις μειώνουν την ταχύτητα ανάγνωσης, καταστρέφουν την οπτική σχέση ανάμεσα στην «εικόνα» της λέξης και στην έννοια που αυτή αντιπροσωπεύει και εν τέλει μειώνουν την πειστική ικανότητα του κειμένου.
Ευτυχώς, με την εξέλιξη των υπολογιστών και του δικτύου, οι περιπτώσεις που είμαστε αναγκασμένοι να χρησιμοποιήσουμε σήμερα τα  γκρίκλις, είναι πολύ λιγότερες σε σχέση με την δεκαετία του ‘85-‘95. Για τις λίγες αυτές περιπτώσεις, και για όλους εσάς, που σας πιάνει πονοκέφαλος, όπως και εμένα,  όταν πρέπει να γράψετε ένα κείμενο σε γκρίκλις, το Excel Λύσεις, φιλοξενεί μια σύντομη μακροεντολή γία WORD με την οποία μετατρέπετε ένα κείμενο που είναι γραμμένο με ελληνικούς χαρακτήρες σε κεφαλαίους λατινικούς (αγγλικούς). Απλά, επιλέξτε το κείμενο που θέλετε να μετατρέψετε και τρέξτε την μακροεντολή Greeklish. Παράδειγμα η  τελευταία πρόταση θα γίνει έτσι: APLA, EPILEKSTE TO KEIMENO POY 8ELETE NA METATREPSETE KAI TREKSTE THN MAKROENTOLH GREEKLISH. Αν το αποτέλεσμα δεν σας αρέσει, με δύο φορές πάτημα του πλήκτρου της αναίρεσης (Ctrl +Ζ), γυρνάτε στο αρχικό κείμενο.
Η μακροεντολή μετατρέπει τα γράμματα του κειμένου σε κεφαλαία και μετά χρησιμοποιεί την αντιστοιχία που βλέπετε στους 2 πίνακες (Array) Greek και Latin. Η αντιστοιχία αυτή είναι ένα μίγμα φωνητικών και οπτικών ομοιοτήτων των 2 αλφάβητων. Μπορείτε να φτιάξετε την δικιά σας αντιστοιχία αλλάζοντας τα αγγλικά στοιχειά στον πίνακα (Array)  Latin. Παράδειγμα, αν δεν σας αρέσει το Θ να αποδίδεται με 8 και το θέλετε να αποδίδεται με ΤΗ, στον πίνακα Latin αλλάξτε το  «8» με «ΤΗ». Επίσης, αν θέλετε γκρίκλις σε πεζά γράμματα, αλλάξτε όλα τα γράμματα του πίνακα Latin σε μικρά αγγλικά της αρεσκείας σας.

Sub Greeklish()
Dim keimeno As Object
Dim pl as Integer, g as Integer, gh As Integer
Dim gramma as String, myLatin  As String
Dim V, Greek, Latin
Set keimeno = Selection
Greek = VBA.Array("Α", "Β", "Γ", "Δ", "Ε", "Ζ", "Η", "Θ", "Ι", "Κ", "Λ", _
"Μ", "Ν", "Ξ", "Ο", "Π", "Ρ", "Σ", "Τ", "Υ", "Φ", "Χ", "Ψ", "Ω", _
"Ά", "Έ", "Ή", "Ί", "Ό", "Ύ", "Ώ", "Ϊ", "Ϋ", "ΐ", "ΰ")
Latin = VBA.Array("A", "B", "G", "D", "E", "Z", "H", "8", "I", "K", "L", _
"M", "N", "KS", "O", "P", "R", "S", "T", "Y", "F", "X", "PS", "W", _
"A", "E", "H", "I", "O", "Y", "W", "I", "Y", "I", "Y")
keimeno = UCase(keimeno)
pl = Len(keimeno)
ReDim V(pl - 1)
For g = 1 To pl
gramma = Mid(keimeno, g, 1)
    For gh = 0 To 34
    If gramma = Greek(gh) Then gramma = Latin(gh): Exit For
    Next
V(g - 1) = gramma
Next
myLatin = Join(V, "")
Selection.TypeText Text:=myLatin
End Sub
This entry was posted in Μακροεντολές, VBA, Word and tagged , , , , . Bookmark the permalink.

3 Responses to Μετατροπή Ελληνικών σε γκρίκλις / Greeklish στο Word

  1. Ο/Η nmm λέει:

    Βρήκα την σελίδα και άλλαξα λίγο να λειτουργεί ως κανονική function του excel.

    Function Greeklish(inp As String)
    Dim keimeno As String
    Dim pl, g, gh As Integer
    Dim gramma, myLatin  As String
    Dim V, Greek, Latin
    keimeno = inp
    Greek = VBA.Array("Α", "Β", "Γ", "Δ", "Ε", "Ζ", "Η", "Θ", "Ι", "Κ", "Λ", _
    "Μ", "Ν", "Ξ", "Ο", "Π", "Ρ", "Σ", "Τ", "Υ", "Φ", "Χ", "Ψ", "Ω", _
    "Ά", "Έ", "Ή", "Ί", "Ό", "Ύ", "Ώ", "Ϊ", "Ϋ", "ΐ", "ΰ")
    Latin = VBA.Array("A", "B", "G", "D", "E", "Z", "H", "TH", "I", "K", "L", _
    "M", "N", "KS", "O", "P", "R", "S", "T", "Y", "F", "X", "PS", "W", _
    "A", "E", "H", "I", "O", "Y", "W", "I", "Y", "I", "Y")
    keimeno = UCase(keimeno)
    pl = Len(keimeno)
    ReDim V(pl - 1)
    For g = 1 To pl
    gramma = Mid(keimeno, g, 1)
        For gh = 0 To 34
        If gramma = Greek(gh) Then gramma = Latin(gh): Exit For
        Next
    V(g - 1) = gramma
    Next
    myLatin = Join(V, "")
    Greeklish = myLatin
    End Function
    

    θέλει μια βελτίωση για αυτό το 34…. αλλά για τα 5 λεπτά που έπρεπε να δώσω λύση ήταν οκ Ευχαριστώ πολύ

  2. Ο/Η vioannis λέει:

    Ευχαριστώ που μοιράστηκες τη δουλεία σου μαζί μας. Δείχνει να δουλεύει σωστά η συνάρτησή σου. Θα επανέλθω να συζητήσουμε το θέμα, μόλις βρω χρόνο.

  3. Ο/Η vioannis λέει:

    Φίλε nmm, επανέρχομαι όπως υποσχέθηκα, αν και με καθυστέρηση.
    Λοιπόν, να η vba συνάρτηση Greeklish για excel , βελτιωμένη όπως σωστά υπέδειξες στον τρόπο που διατρέχει τους πίνακες . Επίσης πρόσθεσα το τελικό σίγμα (ς) που όλα δείχνουν ότι δεν συνεργάζεται με την UCase. Κατά τα άλλα δεν έχει αλλαγές.

    Function Greeklish(keimeno As String) As String
    Application.Volatile True
    Dim Varr As Variant
    Dim inchar As Variant
    Dim exchar As Variant
    Dim pl As Integer, gr As Integer, lu As Integer
    Dim gramma As String
    pl = Len(keimeno)
    
    inchar = Array("Α", "Β", "Γ", "Δ", "Ε", "Ζ", "Η", "Θ", "Ι", "Κ", "Λ", _
    "Μ", "Ν", "Ξ", "Ο", "Π", "Ρ", "Σ", "Τ", "Υ", "Φ", "Χ", "Ψ", "Ω", _
    "Ά", "Έ", "Ή", "Ί", "Ό", "Ύ", "Ώ", "Ϊ", "Ϋ", "ΐ", "ΰ", "ς")
    
    exchar = Array("A", "B", "G", "D", "E", "Z", "H", "8", "I", "K", "L", _
    "M", "N", "KS", "O", "P", "R", "S", "T", "Y", "F", "X", "PS", "W", _
    "A", "E", "H", "I", "O", "Y", "W", "I", "Y", "I", "Y", "S")
    
    ReDim Varr(pl - 1)
    For gr = 1 To pl
    gramma = Mid(keimeno, gr, 1)
    For lu = LBound(inchar) To UBound(inchar)
    If UCase(gramma) = inchar(lu) Then gramma = exchar(lu): Exit For
    Next
    Varr(gr - 1) = gramma
    Next
    Greeklish = Join(Varr, "")
    End Function
    

    Προσθέτω μία ακόμα σχετική vba συνάρτηση για excel , την transfer, η οποία μετατρέπει τους χαρακτήρες ενός κειμένου με βάσει μιας αντιστοιχίας χαρακτήρων που είναι γραμμένοι σε δύο στήλες ή γραμμές του φύλλου. Το ορίσματα inchar είναι μια στήλη (ή γραμμή) στο φύλλο που περιέχει έναν-έναν τους χαρακτήρες που θα αντικατασταθούν στο κείμενο και το όρισμα exchar είναι μια άλλη γραμμή (ή στήλη) που περιέχει αντίστοιχα τους χαρακτήρες που θα τους αντικαταστήσουν. Φυσικά οι δύο στήλες (γραμμές) πρέπει να έχουν το ίδιο μήκος και χαρακτήρες του κειμένου που δεν περιλαμβάνονται στην inchar, δεν θα μετατραπούν. Τα ορίσματα inchar και exchar μπορούν γραφούν και απευθείας στη συνάρτηση σαν πίνακες ή να είναι άλλες συναρτήσεις που επιστρέφουν πίνακες .

    Function transfer(keimeno As String, inchar As Variant, _
            exchar As Variant) As String
    Application.Volatile True
    Dim Varr As Variant
    Dim pl As Integer, gr As Integer, lu As Integer
    Dim gramma As String
    pl = Len(keimeno)
    ReDim Varr(pl - 1)
    For gr = 1 To pl
    gramma = Mid(keimeno, gr, 1)
    For lu = 1 To inchar.Count
    If gramma = inchar(lu) Then gramma = exchar(lu): Exit For
    Next
    Varr(gr - 1) = gramma
    Next
    transfer = Join(Varr, "")
    End Function
    

Τα σχόλια είναι απενεργοποιημένα.