Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
428to432
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
428to432
428to432
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

an Nepumuk, Knacknuss für Experten (Fortsetzung)

an Nepumuk, Knacknuss für Experten (Fortsetzung)
21.05.2004 11:20:04
Michel
Hallo Nepumuk,
Du hast mir gem. Datei t408645 v. 03.Apr. 04 mit deinem Code (siehe unten)bereits sehr geholfen, nochmals besten Dank dafür. Neu kommt hinzu, dass ich den Code umschreiben sollte (was mir nicht gelang). Dein Code ist bereits aktiv ab A1, muss aber erst ab D4 aktiv sein, da die Zeilen 1,2,3 bzw. Spalten A, B, C für andere Zahlen und Namen reserviert sind. Bei der letzten Spalte (z.B. AR)jedoch muss eine 6 stellige Zahl eingegeben werden und dann immer auf die nächste Zeile springen.
Vielen Dank im voraus
Michel
Dein Code:
Option Explicit
Private Declare

Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare 

Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public 

Sub Timerstart()
Dim Key As Byte, KeyLen As Byte
Do
For Key = 48 To 57
If GetAsyncKeyState(Key) + GetAsyncKeyState(Key + 48) = -32768 Then
Sleep 70
Select Case ActiveCell.Column
Case 11 'Spalte K - zwei Ziffern
If KeyLen = 1 Then
Application.SendKeys "{RIGHT}", True
KeyLen = 0
Exit For
Else
KeyLen = KeyLen + 1
End If
Case 29 'Spalte AC - drei Ziffern
If KeyLen = 2 Then
Application.SendKeys "{RIGHT}", True
KeyLen = 0
Exit For
Else
KeyLen = KeyLen + 1
End If
Case 30 'Spalte AD - eine Ziffer und Rückkehr Spalte 1 nächste Zeile
Application.SendKeys "{RIGHT}", True
Application.SendKeys "{DOWN}", True
Application.SendKeys "{LEFT 30}", True
KeyLen = 0
Exit For
Case Else 'alle anderne Spalten eine Ziffer
Application.SendKeys "{RIGHT}", True
KeyLen = 0
Exit For
End Select
End If
Next
Sleep 60
DoEvents
Loop
End Sub


2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: an Nepumuk, Knacknuss für Experten (Fortsetzung)
21.05.2004 12:13:40
Nepumuk
Hallo Michel,
versuch es mal so:


Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As LongAs Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub Timerstart()
    Dim Key As Byte, KeyLen As Byte
    Do
        If Not Application.Intersect(ActiveCell, Range("D3:AR65536")) Is Nothing Then
            For Key = 48 To 57
                If GetAsyncKeyState(Key) + GetAsyncKeyState(Key + 48) = -32768 Then
                    Sleep 70
                    Select Case ActiveCell.Column
                    Case 11 'Spalte K - zwei Ziffern
                        If KeyLen = 1 Then
                            Application.SendKeys "{RIGHT}", True
                            KeyLen = 0
                            Exit For
                        Else
                            KeyLen = KeyLen + 1
                        End If
                    Case 29 'Spalte AC - drei Ziffern
                        If KeyLen = 2 Then
                            Application.SendKeys "{RIGHT}", True
                            KeyLen = 0
                            Exit For
                        Else
                            KeyLen = KeyLen + 1
                        End If
                    Case 44 'Spalte AR - sechs Ziffern und Rückkehr Spalte 4 nächste Zeile
                        If KeyLen = 5 Then
                            Application.SendKeys "{RIGHT}", True
                            Application.SendKeys "{DOWN}", True
                            Application.SendKeys "{LEFT 41}", True
                            KeyLen = 0
                            Exit For
                        Else
                            KeyLen = KeyLen + 1
                        End If
                    Case Else 'alle anderne Spalten eine Ziffer
                        Application.SendKeys "{RIGHT}", True
                        KeyLen = 0
                        Exit For
                    End Select
                End If
            Next
        End If
        Sleep 70
        DoEvents
    Loop
End Sub


Gruß
Nepumuk
Anzeige
AW: an Nepumuk, Knacknuss für Experten (Fortsetzung)
21.05.2004 15:50:24
Michel
Hallo Nepumuk,
wie immer perfekt, besten Dank!
sorry für die späte Rückmeldung!
Schönes Wochenend
Michel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige