Forum - VBA Αυτόματη Επιλογή Γλώσσας πληκτρολογίου

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Αυτόματη Επιλογή Γλώσσας πληκτρολογίου (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/2120-aytomati-epilogi-glossas-pliktrologioy.html)

Αυτόματη Επιλογή Γλώσσας πληκτρολογίου

Καλησπέρα σε όλους τους φίλους του φόρουμ.

Θα ήθελα για μια ακόμα φορά την βοήθεια τον ειδικών.

Σχετικά με το χρήσιμο παράδειγμα του Τάσου με θέμα “Αυτόματη επιλογή γλώσσας πληκτρολογίου στο excel “στην ενότητα Χρήσιμα αρχεία & Παραδείγματα.

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

Ευχαριστώ εκ τον προτέρων
Γιώργος

Καλημέρα Γιώργο!

Θέλεις σε όλο το βιβλίο να πληκτρολογούνται Ελληνικά κεφαλαία ή μόνο σε ορισμένα φύλλα;
Θέλεις σε όλο το φύλλο να πληκτρολογούνται Ελληνικά κεφαλαία ή μόνο σε μια συγκεκριμένη περιοχή (πχ. συγκεκριμένες στήλες);
Μιλάμε για ελληνικά κεφαλαία ή κεφαλαία χωρίς περιορισμό στη γλώσσα πληκτρολόγησης;
Στο βιβλίο σου (ή σε τμήματα του) θα χρησιμοποιούνται μόνο ελληνικοί ή και αγγλικοί χαρακτήρες;

Πρέπει να γνωρίζουμε τα παραπάνω για να διαμορφώσουμε τον κώδικα VBA κατάλληλα.

Περιμένουμε να σε διαβάσουμε.

Φιλικά

Τάσος

Καλημέρα,
Τάσο σε ευχαριστώ για την άμεση ανταπόκριση σου.

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

Ελπίζω να έγινα κατανοητός

Γιώργος

Γιώργο, το ζητούμενο σου είναι εφικτό.
Φυσικά ο χρήστης παρά τον όποιο αυτοματισμό εφαρμόσουμε (χωρίς να εισχωρήσουμε βαθιά στο λειτουργικό σύστημα) μπορεί να αλλάξει τη γλώσσα του πληκτρολογίου όπως επίσης και την κατάσταση του (Πεζά - Κεφαλαία).

Σε μια κοινή λειτουργική μονάδα έχουμε τον κώδικα:

Κώδικας:

Option Explicit

Const hKL_GREEK As Long = &H408

Const SETFOREXCEL = &H100

Const KEYEVENTF_KEYUP As Long = &H2

Const VK_CAPITAL As Long = &H14

Const KEYEVENTF_EXTENDEDKEY As Long = &H1

Const XL_GR_LANG As Long = 4184
 

Declare Sub keybd_event Lib "User32" ( _

                        ByVal bVk As Byte, ByVal bScan As Byte, _

                        ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 

Declare Function MapVirtualKey Lib "User32" Alias "MapVirtualKeyA" ( _

                               ByVal wCode As Long, ByVal wMapType As Long) As Long
 

Declare Function GetKeyState Lib "User32" (ByVal nVirtKey As Long) As Long
 

Declare Function ActivateKeyboardLayout Lib "User32" ( _

                                        ByVal hKL As Long, ByVal Flags As Long) As Long

Declare Function GetKeyboardLayout Lib "User32" ( _

                                   ByVal dwLayout As Long) As Long

                                   

Declare Function GetWindowThreadProcessId Lib "User32" ( _

                                          ByVal hwnd As Long, lpdwProcessId As Long) As Long

Dim ProcID As Long

Dim xlThreadID As Long
 

Public Function SetCapsLock(ByVal bState As Boolean)

    If bState = CBool(GetKeyState(VK_CAPITAL) = 1) Then Exit Function

    keybd_event vbKeyCapital, MapVirtualKey(vbKeyCapital, 0), KEYEVENTF_EXTENDEDKEY Or 0, 0

    keybd_event vbKeyCapital, MapVirtualKey(vbKeyCapital, 0), KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0

End Function
 

Public Sub SetGreekLangWithCaps()

    If xlThreadID = 0 Then xlThreadID = GetWindowThreadProcessId(Application.hwnd, ProcID)

    If (GetKeyboardLayout(ByVal xlThreadID) Mod 10000) <> XL_GR_LANG Then

        ActivateKeyboardLayout hKL_GREEK, SETFOREXCEL

    End If

    SetCapsLock True

End Sub

Στον κώδικα του βιβλίου (ThisWorkbook) έχουμε τον κώδικα:

Κώδικας:

Option Explicit
 

Private Sub Workbook_Open()

    If ActiveSheet.CodeName = "Sheet1" Then SetGreekLangWithCaps

    ' όπου "Sheet1" = το Κωδικό όνομα του φύλλου που θα εφαρμοστεί η διαδικασία,

    ' όπως φαίνεται στον VBE στο παράθυρο άνω αριστερά**

    ' ** Όχι το όνομα που υπάρχει  μέσα στην παρένθεση αλλά

    ' το αριστερό τμήμα του πριν από την παρένθεση 

    ' πχ:Sheet1(Όνομα Φύλλου).

End Sub

Στον κώδικα του φύλλου (Sheet1) έχουμε τον κώδικα:

Κώδικας:

Option Explicit
 

Private Sub Worksheet_Activate()

    SetGreekLangWithCaps

End Sub
 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    SetGreekLangWithCaps

End Sub

Σου επισυνάπτω ένα παράδειγμα.

Καλή συνέχεια!

Τάσος

Τάσο,σε ευχαριστώ πολύ για τον χρόνο που διάθεσες για να λύσεις το πρόβλημα μου

Είναι αυτό που ήθελα
Να είσαι καλά.Καλή συνέχεια

Γιώργος