Εμφάνιση ενός μόνο μηνύματος
  #4  
Παλιά 16-10-12, 14:12
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.035
Προεπιλογή

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

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

Κώδικας:
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
Σου επισυνάπτω ένα παράδειγμα.

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

Τάσος
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm XlGrKB_and_Caps.xlsm (21,4 KB, 59 εμφανίσεις)
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση