Cursor control

[rwv]

I'd like to have the cursor automatically move right one cell after one text character is input in the far left cell of a row, then drop to the left most cell of the next row upon pressing Enter where the process repeats. Am I dreaming or is that possible in Excel?

 

[mikerickson]

The part where entering a character and the cursor moves to a different cell without Enter/Tab/etc. is Dreaming.

Sorry.

 

[Darkshrimp]

Correct me if i'm wrong, but i dont' think VBA has the capability to control the cursor. You'd need a more powerful programming tool.

 

[rwv]

Actually using VBA macros in Excel does allow cursor control. I've been working on it as I have time and it does work, work being the operative word. It takes a lot of time to program a simple application using Excel macros. I'll get back to that after I finish the project that pays the bills.

 

[Legacy 98055]

It's possible but it would be easier to use controls that are made for such as task such as a textbox control... I made a mock cell edit project and posted it here somewhere. It uses a textbox that sizes itself to the activecell. Look for it and maybe you can use it.

 

[Legacy 98055]

Here is an improvement of what I made earlier. It uses a transparent userform with a textbox. You would need to write a bit more code to make this more functionally representative of true cell editing behavior but for what you want it may do well enough just as it is. It provides two events borrowed from the textbox. You could easily borrow other events if you wish. The code example only allows alphanumeric entries, selects the offset(,1) of the activecell after each valid keypress, and reacts to the enter key by dropping down one row to the first column. Just select a cell and type something.

Public Event CellKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, ByVal Target As Range)
Public Event CellKeyPress(ByVal KeyAscii As MSForms.ReturnInteger, ByVal Target As Range)

<A HREF="http://cid-ea73b3a00e16f94f.skydrive.live.com/self.aspx/Mr%20Excel%20Example/PseudoCellEdit.zip" TARGET="_blank">Example Workbook: PseudoCellEdit.xls.zip</A>

Download the example or...

<b>Add a userform named frmCellEdit. Draw out TextBox1. Paste in this code:</b>

Option Explicit

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwnewlong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const HWND_TOP As Long = 0

Public Event CellKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, ByVal Target As Range)
Public Event CellKeyPress(ByVal KeyAscii As MSForms.ReturnInteger, ByVal Target As Range)

Private phWnd As Long
Private pPointsPerPixelX As Single
Private pPointsPerPixelY As Single
Private pTarget As Range

Friend Property Set Target(Range As Range)
    Set pTarget = Range
End Property

Friend Property Get Target() As Range
    Set Target = pTarget
End Property

Private Sub RemoveCaption()
    SetWindowLong phWnd, -16, GetWindowLong(phWnd, -16) And Not &HC00000
    DrawMenuBar phWnd
End Sub

Private Sub MakeToolWin()
    SetWindowLong phWnd, -20, GetWindowLong(phWnd, -20) And &H80
End Sub

Private Sub MakeAlmostTransparent()
    SetWindowLong phWnd, -20, GetWindowLong(phWnd, -20) Or &H80000
    SetLayeredWindowAttributes phWnd, 0, 1, &H2&
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    RaiseEvent CellKeyDown(KeyCode, Shift, pTarget)
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    RaiseEvent CellKeyPress(KeyAscii, pTarget)
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Application.EnableEvents = False
    Set pTarget = ActiveCell
    pTarget.Select
    Application.EnableEvents = True
End Sub

Private Sub UserForm_Initialize()
    Dim hdc As Long
    
    If Val(Application.Version) < 9 Then
        phWnd = FindWindow("ThunderXFrame", Caption)
    Else
        phWnd = FindWindow("ThunderDFrame", Caption)
    End If
    Call RemoveCaption
    Call MakeToolWin
    hdc = GetDC(0)
    pPointsPerPixelX = 72 / GetDeviceCaps(hdc, LOGPIXELSX)
    pPointsPerPixelY = 72 / GetDeviceCaps(hdc, LOGPIXELSY)
    Me.BackColor = vbWhite
    TextBox1.BackColor = vbWhite
    TextBox1.BorderStyle = fmBorderStyleNone
    TextBox1.SpecialEffect = fmSpecialEffectFlat
    ReleaseDC 0, hdc
    RemoveCaption
    MakeToolWin
    MakeAlmostTransparent
End Sub

Friend Sub SetPosition(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
    Dim X As Long, Y As Long, xx As Long, yy As Long
    
    TextBox1.Font.Size = pTarget.Font.Size
    X = CLng(ActiveWindow.PointsToScreenPixelsX(0) + (x1 / pPointsPerPixelX))
    Y = CLng(ActiveWindow.PointsToScreenPixelsY(0) + (y1 / pPointsPerPixelY))
    xx = CLng((x2 / pPointsPerPixelX))
    yy = CLng((y2 / pPointsPerPixelY))
    SetWindowPos phWnd, HWND_TOP, X, Y, xx, yy, 0
    Application.EnableEvents = False
    TextBox1.Select False
    Application.EnableEvents = True
End Sub

Private Sub UserForm_Resize()
    TextBox1.Move 0, 0, Me.width, Me.height
End Sub

<b>In a worksheet, add this code:</b>

Option Explicit

Private WithEvents MockEdit As frmCellEdit

Private Sub MockEdit_CellKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, ByVal Target As Range)
    Select Case KeyCode
        Case 46: Selection.ClearContents
        Case 13: Cells(Target.Row + 1, 1).Select
    End Select
End Sub

Private Sub MockEdit_CellKeyPress(ByVal KeyAscii As MSForms.ReturnInteger, ByVal Target As Range)
    If Chr(KeyAscii) Like "?" Or Chr(KeyAscii) Like "#" Then
        Target = Target & Chr(KeyAscii)
        MockEdit.Target.Offset(, 1).Select
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If MockEdit Is Nothing Then
        Set MockEdit = New frmCellEdit
        MockEdit.Show vbModeless
    End If
    With ActiveCell
        Set MockEdit.Target = .Item(1)
        MockEdit.SetPosition .Left, .Top, .width, .height
    End With
End Sub

Note that you will need to fire the selection change event to intialize this. You could initialize it on workbook open and sheet activate to avoid having to make a selection...