
16-10-12, 14:12
|
 | Διαχειριστής Όνομα: Τάσος Φιλοξενιδης Έκδοση λογισμικού 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
Σου επισυνάπτω ένα παράδειγμα.
Καλή συνέχεια!
Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών |