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

[nakosg]

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

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

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

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

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

[Tasos]

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

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

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

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

Φιλικά

Τάσος

[nakosg]

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

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

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


Γιώργος

[Tasos]

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

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

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

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

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

Τάσος

[nakosg]

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

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

Γιώργος