Suche Makro recorder (Script-Editor mit Aufzeichnung)

[trebuh]

Hallo Harald,

wenn das mit dem Sendkeys so weiter geht, dann habe ich bald keine Haare mehr auf dem Kopf;-)

Der Code:

Code [Auswählen] Erweitern

If CBool(GetKeyboardState(vbKeyNumlock) And 1) = False Then _
        Call SetKeyboardState(vbKeyNumlock, 1)
bringt mir die Fehlermeldung:

Fehler beim Kompilieren:
Falsche Anzahl an Argumenten oder ungültige Zuweisung zu einer Eigenschaft

Gruß Hubert

[bahasu]

Hi Hubert,

was passiert bei: Call SetKeyboardState(vbKeyNumlock)?

Harald

[trebuh]

Hallo Harald,

wie darf ich die Frage jetzt verstehen?
- Fragst Du mich, was bei dem Befehl passieren sollte?  oder
- Was bei mir genau passiert?

[bahasu]

Hi,
streich ",1" weg und berichte, was passiert.

Harald

[trebuh]

Nichts gutes.

Zuerst dachte ich jetzt gehts (Zumindest wird mein Code abgearbeitet, d.h. Exe- Anwendung geöffnet und die Sendkey-Befehle werden ausgeführt.)

Dann hängt sich Access auf und es erscheint das zu guter letzt die  Fehlermeldung (siehe im Anhang)

[bahasu]

Hi,

... dann habe ich bald keine Haare mehr auf dem Kopf

Diesen Zustand habe ich schon erreicht.   

Das folgende ohne Garantie (deswegen auch in meinem ersten Beitrag das Wort "tricky"). Bei dem Kommando gibt es einen optionalen Parameter
SendKeys string[, wait].

Also
SendKeys Bitte hier Dein Kommando eintragen, True

[trebuh]

Hi,

dann laufen jetzt 2 Männer mit herausgerissenen Haaren herum:-)))

das ",True" habe ich bereits drin.

Wie ist es eigentlich mit dem Link 7.8 bei Donkarl. Da ist ja folgender Code:

Code [Auswählen] Erweitern

  ' 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 VK_SCROLL = &H91
      Const VK_CAPITAL = &H14
      Const KEYEVENTF_EXTENDEDKEY = &H1
      Const KEYEVENTF_KEYUP = &H2
      Const VER_PLATFORM_WIN32_NT = 2
      Const VER_PLATFORM_WIN32_WINDOWS = 1

Function IsCapsLockOn() As Boolean
        Dim o As OSVERSIONINFO

        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsCapsLockOn = keys(VK_CAPITAL)
End Function

Sub ToggleCapsLock()
        Dim o As OSVERSIONINFO

        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)

        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
        'Toggle capslock
            keys(VK_CAPITAL) = Abs(Not keys(VK_CAPITAL))
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
          'Simulate Key Press>
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
          'Simulate Key Release
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
               Or KEYEVENTF_KEYUP, 0
        End If
End Sub

Function IsNumLockOn() As Boolean
        Dim o As OSVERSIONINFO
       
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsNumLockOn = keys(VK_NUMLOCK)
End Function

Sub ToggleNumLock()
        Dim o As OSVERSIONINFO
               
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)

          If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
                keys(VK_NUMLOCK) = Abs(Not keys(VK_NUMLOCK))
                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 Sub

Function IsScrollLockOn()
        Dim o As OSVERSIONINFO
       
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsScrollLockOn = keys(VK_SCROLL)
End Function

Sub ToggleScrollLock()
        Dim o As OSVERSIONINFO
       
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
            keys(VK_SCROLL) = Abs(Not keys(VK_SCROLL))
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
            'Simulate Key Press
            keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
            'Simulate Key Release
            keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
        End If
End Sub

Sub mySendKeys(sKeys As String, Optional bWait As Boolean = False)
Dim bNumLockState As Boolean
Dim bCapsLockState As Boolean
Dim bScrollLockState As Boolean
    bNumLockState = IsNumLockOn()
    bCapsLockState = IsCapsLockOn()
    bScrollLockState = IsScrollLockOn()
    SendKeys sKeys, bWait
    If IsNumLockOn() <> bNumLockState Then
        ToggleNumLock
    End If
    If IsCapsLockOn() <> bCapsLockState Then
        ToggleCapsLock
    End If
    If IsScrollLockOn() <> bScrollLockState Then
        ToggleScrollLock
    End If
End Sub

Function fSendKeys(sKeys As String, Optional bWait As Boolean = False)
' Function to make it callable from macros
    mySendKeys sKeys, bWait
End Function

Nur welche funktion muss ich da aufrufen? Die Funktion "mySendKeys"? und wie?

Wirklich tricky und buggy.

[bahasu]

Hi Hubert,

es scheint jetzt immer mehr "tricky" zu werden.

Vielleicht ist es hilfreich, erst einmal eine vereinfachte Version zu probieren, um einzukreisen, wo der Absturz ausgelöst wird.

Deshalb die Frage:
Funktionieren Deine Routinen ohne access-Programm-Absturz mit dem normalen SendKeys ohne die "numlock-Anweisungen"?


Das im obigen Link verwendete mysendkeys ersetzt den normalen sendkeys-Befehl und hat den Vorteil, dass Du nicht bei jedem aufruf an numlock, capslock und dergl denken mußt.

Harald

[trebuh]

Hi,

es scheint jetzt immer mehr "tricky" zu werden.

Ja das stimmt! Mittlerweile muss ich darüber lachen.
Also mein Code funkioniert jetzt in soweit, dass ich am Schluß jetzt einfach

Code [Auswählen] Erweitern

SendKeys "{NumLock}", True
setze.

Nach dem Code-Tipp von Maggie-May kommt die Fehlermeldung:
Fehler beim Kompilieren:
Sub oder Function nicht definiert

Und nachdem ich das

Code [Auswählen] Erweitern

If CBool(GetKeyboardState(vbKeyNumlock) And 1) = False Then _
        Call SetKeyboardState(vbKeyNumlock, 1)

in

Code [Auswählen] Erweitern

If CBool(GetKeyboardState(vbKeyNumlock) And 1) = False Then _
        Call SetKeyboardState(vbKeyNumlock)
umgeändert habe, hängt Access sich auf.

Andere Frage (zu den mysendkeys):
Heißt das, ich setze den Code in ein Modul und schreibe dann statt SendKeys "%(O)", True ganz einfach mysendkeys "%(O)", True? Und das wäre alles? (Ich probiers einfach mal. Es kann ja nur ein Fehler kommen )

Gruß Hubert

[MaggieMay]

Nach dem Code-Tipp von Maggie-May kommt die Fehlermeldung:
Fehler beim Kompilieren:
Sub oder Function nicht definiert

Sorry, das hatte ich übersehen, dies ist die fehlende Prozedur:

Code [Auswählen] Erweitern

Sub SetKeyState(intKey As Integer, fTurnOn As Boolean)
'
' Tastatur-Eigenschaft NumLock zurücksetzen
    Dim abytBuffer(0 To 255) As Byte
    GetKeyboardState abytBuffer(0)
    abytBuffer(intKey) = CByte(Abs(fTurnOn))
    SetKeyboardState abytBuffer(0)
End Sub