• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Numlock wordt uitgeschakeld na openen bestand

Status
Niet open voor verdere reacties.
S

Symphysodon

Gebruiker
Lid geworden
14 dec 2012
Berichten
468
Beste forummers,

Ik wist niet zeker of ik een nieuwe topic moest openen, omdat hierover al een vraag is gepost. De vraag is hetzelfde de oorzaak is anders. Zoals het advies gegeven, gebruik ik geen send keys, maar krijg toch hetzelfde probleem: Na het openen van het bestand wordt de Numlock uitgeschakeld en de "." werkt niet meer als decimaal scheidingsteken. Ik gebruik de volgende code bij het openen van het bestand:
Code: 
 ' Declare Type for API call:
      Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128   '  Maintenance string for PSS usage
      End Type

      ' API declarations:
      Private Declare Function GetVersionEx Lib "kernel32" _
         Alias "GetVersionExA" _
         (lpVersionInformation As OSVERSIONINFO) As Long

      Private Declare Sub keybd_event Lib "user32" _
         (ByVal bVk As Byte, _
          ByVal bScan As Byte, _
          ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

      Private Declare Function GetKeyboardState Lib "user32" _
         (pbKeyState As Byte) As Long

      Private Declare Function SetKeyboardState Lib "user32" _
         (lppbKeyState As Byte) As Long

      ' Constant declarations:
      Const VK_NUMLOCK = &H90
      Const KEYEVENTF_EXTENDEDKEY = &H1
      Const KEYEVENTF_KEYUP = &H2
      Const VER_PLATFORM_WIN32_NT = 2
      Const VER_PLATFORM_WIN32_WINDOWS = 1


Private Sub Workbook_Open()
    
Dim o As OSVERSIONINFO
Dim NumLockState As Boolean

landeninstellingen

Application.DecimalSeparator = "."
Application.ThousandsSeparator = ","
Application.UseSystemSeparators = True
    
'Kruisje deactiveren
ExcelSluitenUitschakelen
  
  o.dwOSVersionInfoSize = Len(o)
  GetVersionEx o
  Dim keys(0 To 255) As Byte
  GetKeyboardState keys(0)

  ' NumLock handling:
  NumLockState = keys(VK_NUMLOCK)
  If NumLockState <> True Then    'Turn numlock on
    If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
      keys(VK_NUMLOCK) = 1
      SetKeyboardState keys(0)
    ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=== WinNT
    'Simulate Key Press
      keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
    'Simulate Key Release
      keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
         Or KEYEVENTF_KEYUP, 0
    End If
  End If


Interaction.DDEExecute "^{f1}", True
Application.DisplayFullScreen = True
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False

End Sub
 
les 1. blijf af van de werkomgeving van een gebruiker
les 2. gebruik een userform als je de gebruikersinvoer wil begeleiden.
les 3. zoek geen oplossingen voor self-inflicted injuries.

Kort samengevat: gooi al die code weg.
 
Laatst bewerkt:
Met dit in een Module kan je er voor zorgen dat NumLock altijd wordt aan gezet:
Code: 
Public Declare Function GetKeyState Lib "user32" _
    (ByVal nVirtKey As Long) As Integer
    
Public Declare Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, _
     ByVal bScan As Byte, ByVal dwFlags As Long, _
     ByVal dwExtraInfo As Long)
     
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_NUMLOCK = &H90

Sub SetNumLockOn()
    If Not CBool(GetKeyState(VK_NUMLOCK)) Then
        keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY, 0
        keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    End If
End Sub

Voor 64-bit Office pas je uiteraard de functie declaraties aan.
 
De code gebruiken we al jaren zonder problemen, het probleem is er pas sinds we over gegaan zijn naar office 365.

Ik heb de declaraties aangepast, maar weet het niet voor de Sub keybd event. In eerste instantie bleef de Numlock aan, dit was helaas maar 1 malig.


Code: 
Public Declare PtrSafe Function GetKeyState Lib "user32" _
    (ByVal nVirtKey As Long) As Integer
    
Public Declare Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, _
     ByVal bScan As Byte, ByVal dwFlags As Long, _
     ByVal dwExtraInfo As Long)

Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_NUMLOCK = &H90
 
Je laat alleen de declaraties zien terwijl je de Sub SetNumLockOn moet aanroepen vanuit de Workbook_Open.
 
zoiets:
Code: 
  o.dwOSVersionInfoSize = Len(o)
  GetVersionEx o
  Dim keys(0 To 255) As Byte
  GetKeyboardState keys(0)

  ' NumLock handling:
  NumLockState = keys(VK_NUMLOCK)
  If NumLockState <> True Then    'Turn numlock on
    If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
      keys(VK_NUMLOCK) = 1
      SetKeyboardState keys(0)
    ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=== WinNT
    'Simulate Key Press
      keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
    'Simulate Key Release
      keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
         Or KEYEVENTF_KEYUP, 0
    End If
  End If

Ik zag dat de code je gaf ik al had. Zie post. Alleen stonden de declaraties in ThisWorkbook. Daar heb ik ze nu uitgehaald.
 
Dergelijke declaraties moeten altijd in een module.
 
Duidelijk.

SNB heeft wel een beetje gelijk. Dit is waanzinnig moeilijk want hoe kan ik die aanroep beter krijgen, de code is voor windows98 en niet voor windows8 toch?
 
Wat ik plaatste in #3 is voldoende.
Waarom zou je Windows 98 nog ondersteunen?
 
Ja Niet natuurlijk. We hebben helaas nog wel een paar xp computers staan.

In #3 zei je dat het in een module moet. en in #5 zeg je dat de aanroep in workbook-open moet, beetje verwarrend.
Maar het werkt. Ik heb de aanroep in de sub van #3 in Workbook-open geplaatst en verwijderd uit de module. Voilà de Numlock blijft aan.

Bij het weghalen van de if then (windos98 en NT) uit #6 werkt het niet en gaat de Numlock weer uit.

Edmoor hartelijk dank.

Mvg,
Marco
 
De code zet je in een module, de aanroep ervan in de Workbook_Open.
 
De juiste declaratie, geschikt voor 32 en 64 bit Excel, is als volgt:

Code: 
#If VBA7 Then
Public Declare PtrSafe Function GetKeyState Lib "user32" _
    (ByVal nVirtKey As Long) As Integer
    
Public Declare PtrSafe Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, _
     ByVal bScan As Byte, ByVal dwFlags As Long, _
     ByVal dwExtraInfo As LongPtr)
#Else
Public Declare Function GetKeyState Lib "user32" _
    (ByVal nVirtKey As Long) As Integer
Public Declare Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, _
     ByVal bScan As Byte, ByVal dwFlags As Long, _
     ByVal dwExtraInfo As Long)
#End If
Zie: http://www.jkp-ads.com/articles/apideclarations.asp
 
Werkt het ook bij 0ffice365 naar office 7 32 bit? Op het laatste krijg ik een compileerfout. Ik krijg het bestand wel geopend in office365 64 bits.

In ThisWorkbook heb ik de volgende declaraties staan:
Code: 
' Declare Type for API call:

 
      Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128   '  Maintenance string for PSS usage
      End Type

      ' API declarations:
      [COLOR="#FF0000"]Private Declare PtrSafe Function GetVersionEx Lib "kernel32" _
         Alias "GetVersionExA" _
         (lpVersionInformation As OSVERSIONINFO) As Long

      Private Declare PtrSafe Function GetKeyboardState Lib "user32" _
         (pbKeyState As Byte) As Long

      Private Declare PtrSafe Function SetKeyboardState Lib "user32" _
         (lppbKeyState As Byte) As Long

      ' Constant declarations:
      
      Const VER_PLATFORM_WIN32_NT = 2
      Const VER_PLATFORM_WIN32_WINDOWS = 1[/COLOR]

In module heb ik het aangepast volgens:
Code: 
#If VBA7 Then
   [COLOR="#FF0000"] Public Declare PtrSafe Function GetKeyState Lib "user32" _
        (ByVal nVirtKey As Long) As Integer
        
    Public Declare PtrSafe Sub keybd_event Lib "user32" _
        (ByVal bVk As Byte, _
         ByVal bScan As Byte, ByVal dwFlags As Long, _
         ByVal dwExtraInfo As LongPtr)[/COLOR]
#Else
    Public Declare Function GetKeyState Lib "user32" _
        (ByVal nVirtKey As Long) As Integer
    Public Declare Sub keybd_event Lib "user32" _
        (ByVal bVk As Byte, _
         ByVal bScan As Byte, ByVal dwFlags As Long, _
         ByVal dwExtraInfo As Long)
#End If
'Public Declare PtrSafe Function GetKeyState Lib "User32" _
'    (ByVal nVirtKey As Long) As Integer
'
'Public Declare Sub keybd_event Lib "User32" _
'    (ByVal bVk As Byte, _
'     ByVal bScan As Byte, ByVal dwFlags As Long, _
'     ByVal dwExtraInfo As Long)

Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_NUMLOCK = &H90
 
Laatst bewerkt:
Office2007

Gedeelte van de code wordt in het rood weergegeven, zie aanpassing #13, met de foutmelding: compileerfout
 
Dat hele gedeelte in de ThisWorkbook sectie hoort daar niet.
 
Als je de tweede optie gebruikt zou je het rood worden van de regels moeten kunnen negeren, Excel 2007 zal toch geen gebruik maken van dat deel van de code.
 
Waarschijnlijk moet ik een stapje terug. De code werkt nu wel, maar als ik nu wat invul krijg ik een rondje te zien en duurt het even voor ik naar een andere cel kan.
Maw het blad wordt super traag en niet meer werkzaam.

Is er niet een manier om de code van de headers sneller te maken.

Ik kan natuurlijk een formulier maken, maar het probleem is dat er meestal grote invultabellen zijn waar weer tig formules aangekoppeld zitten.

@Edmoor
Als ik de declaraties daar weg haal en in een module zet krijg ik een compileerfout melding.
 
Plaats je document zoals deze nu is.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan