# Celda para un solo carácter con pase a siguiente sin esperas



## Esgrimidor (Aug 12, 2009)

Celda para un solo carácter con pase a siguiente sin esperas. 

¿ Cómo se configura una celda excel para que sólo sea posible meter un carácter y que tras introducirlo salte el cursor a la celda siguiente inferior ?

Por ejemplo el dígito 1 hace que se escriba el uno y luego el cursor pase a la celda inferior. Y si le damos a enter que pase a la celda siguiente sin escribir nada en la celda actual.


----------



## mjrofra (Aug 14, 2009)

Hola esgrimidor,

en validación de datos tienes la opción "Longitud de texto", ahí puedes controlar para que en la celda sólo se pueda introducir un caracter.

De manera predefinida (a menos que hayas modificado ese comportamiento) al presionar Intro tras ingresar el valor o texto en la celda, saltará a la celda siguiente celda inferior.


----------



## Juan Pablo González (Aug 14, 2009)

Sin embargo, no hay forma de que Excel pase a la siguiente celda con solo presionar 1, ya que no se puede correr macros mientras Excel esté en modo edición.


----------



## Esgrimidor (Aug 14, 2009)

Gracias a los dos. 

hay algún truquito que permita saltar esta limitación. 

O sea. Lo que yo trato está claro. 

Es una lista con unos doscientos y pico items o líneas a comprobar. En la mayoría de los casos es una comprobación a toro pasado. Es decir al final del trabajo, pero también cabe la posibilidad de dos o tres revisiones. O sea que es posible que hayan distintos valores en las celdas y lo que me interesa es proponer el nuevo valor con un solo golpe de tecla o una maniobra rápida. 

Hay forma o alternativa ?

Por lo mismo también me gustaría si hay forma de proponer que todo se ponga con un valor determinado. 

Por ejemplo que en el rango D4:D263 se ponga todo con el mismo valor. Por ejemplo un 1 o el símbolo ese de check o comprobación que no se cómo se hace.....

Gracias de nuevo


----------



## Esgrimidor (Aug 17, 2009)

Juan Pablo González said:


> Sin embargo, no hay forma de que Excel pase a la siguiente celda con solo presionar 1, ya que no se puede correr macros mientras Excel esté en modo edición.



Se podría lograr con la tecla Enter ?

Con la tecla enter propiciar el cambio (o marcado o no marcado ) y que pasara a la celda inferior. 

Con la tecla hacia abajo que pasara de una celda a otra sin cambio. 

Y que el signo prefijado fuera cualquiera, un check por ejemplo, que creo se puede hacer con un tipo de letra y la "a" de ese tipo de letra. 

Gracias otra vez


----------



## Juan Pablo González (Aug 18, 2009)

Intente con esto.  Hay que correr el macro "SetKeys" para que las teclas "Enter" cambien de funcionalidad.  El macro "UnsetKeys" las hace funcionar normalmente.

Hay que cambiar el tipo de letra de la columna que tendrá los checks a "Windings", y cambiar la constante "CHECKMARK_COLUMN" al número correcto. Asumí la columna D:D, que es la columna número 4.


```
Option Explicit

Sub SetKeys()
    Application.OnKey "{Enter}", "RunIt"
    Application.OnKey "~", "RunIt"
End Sub

Sub UnsetKeys()
    Application.OnKey "{Enter}"
    Application.OnKey "~"
End Sub

Sub RunIt()
    Dim rng As Range
    
    Const CHECKMARK_COLUMN As Long = 4  'D:D
    Const CHECK_STRING As String = "ü"  'Windings font
    
    If TypeName(Selection) = "Range" Then
        Set rng = Selection
    Else
        Exit Sub
    End If
    
    If rng.Column <> CHECKMARK_COLUMN Then
        Select Case Application.MoveAfterReturnDirection
        Case XlDirection.xlDown
            rng.Offset(1).Select
        Case XlDirection.xlToRight
            rng.Offset(, 1).Select
        Case XlDirection.xlUp
            rng.Offset(-1).Select
        Case XlDirection.xlToLeft
            rng.Offset(, -1).Select
        End Select
        Exit Sub
    End If
    
    If rng.Value = CHECK_STRING Then
        rng.Value = ""
    Else
        rng.Value = CHECK_STRING
    End If
    
    rng.Worksheet.Cells(rng.Row + 1, 1).Select
    
End Sub
```


----------



## Esgrimidor (Aug 19, 2009)

Juan Pablo voy a probar la macro y comento. 
Un abrazo
Y muchas gracias salga lo que salga.


----------



## Esgrimidor (Aug 19, 2009)

No veo interacción. 
Lo que he intentado es : 

Abro mi libro en cuestión. 
Voy a la hoja donde quiero proponer la lista de comprobación 

sobre la pestaña de la misma botón derecho ratón e introduzco el código aportado. Pero no noto cambio. 

Qué procedimiento tengo que seguir. 

Propuse en vez de la columna D:D , la columna F:F


----------



## Juan Pablo González (Aug 19, 2009)

El código hay que copiarlo en un módulo normal... Alt F11 - Insertar - Modulo, y pegarlo ahí.

Luego hay que ejecutar el macro "SetKeys" y ya, ahí si debe funcionar al hacer Enter sobre la columna D (o la F si se modifica el código).


----------



## Esgrimidor (Aug 19, 2009)

Lo pruebo inmediatamente y comento.


----------



## Esgrimidor (Aug 12, 2009)

Celda para un solo carácter con pase a siguiente sin esperas. 

¿ Cómo se configura una celda excel para que sólo sea posible meter un carácter y que tras introducirlo salte el cursor a la celda siguiente inferior ?

Por ejemplo el dígito 1 hace que se escriba el uno y luego el cursor pase a la celda inferior. Y si le damos a enter que pase a la celda siguiente sin escribir nada en la celda actual.


----------



## Esgrimidor (Aug 19, 2009)

No me funciona bien 









el simbolo que me dibuja en la columna F es ü y tras darle a enter el cursor se va al comienzo de la siguiente fila o línea, no se mantiene en la columna F.

Qué estoy haciendo mal ?


----------



## Greg Truby (Aug 20, 2009)

Con un par de cambiocitos funciona muy bien.


```
Option Explicit
Sub SetKeys()
    Application.OnKey "{Enter}", "RunIt"
    Application.OnKey "~", "RunIt"
End Sub
Sub UnsetKeys()
    Application.OnKey "{Enter}"
    Application.OnKey "~"
End Sub
Sub RunIt()
    Dim rng As Range
    
    Const CHECKMARK_COLUMN As Long = 4  'D:D
    Const CHECK_STRING As String = "ü"  'Windings font
    
    If TypeName(Selection) = "Range" Then
        Set rng = Selection
    Else
        Exit Sub
    End If
    
    If rng.Column = CHECKMARK_COLUMN Then
    
        If rng.Value = CHECK_STRING Then
            rng.Value = ""
        Else
            rng.Value = CHECK_STRING
            rng.Font.Name = "Wingdings"
        End If
    End If
    
    Select Case Application.MoveAfterReturnDirection
        Case XlDirection.xlDown
            rng.Offset(1).Select
        Case XlDirection.xlToRight
            rng.Offset(, 1).Select
        Case XlDirection.xlUp
            rng.Offset(-1).Select
        Case XlDirection.xlToLeft
            rng.Offset(, -1).Select
    End Select
    
End Sub
```


----------



## Greg Truby (Aug 20, 2009)

Actualmente, si usted pone el siguiente en el módulo para la hoja creo que se puede desocupar un poco de tener que correr UNSETKEYS().
	
	
	
	
	
	



```
Option Explicit
Private Const mc_intCol As Integer = 4  ' only target column 4
Private Sub Worksheet_Activate()
    If ActiveCell.Column = mc_intCol Then
        SetKeys
    Else
        UnsetKeys
    End If
End Sub
Private Sub Worksheet_Deactivate()
    UnsetKeys
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = mc_intCol Then
        SetKeys
    Else
        UnsetKeys
    End If
End Sub
```


----------



## Esgrimidor (Aug 20, 2009)

Me pongo a practicar inmediatamente. 
A ver si me sale. 

Muchas gracias y comentaré.


----------



## Esgrimidor (Aug 20, 2009)

Funciona estupendamente bien. 

Me queda por probar lo de unsetkeys que no entiendo muy bien lo que quiere decir el módulo de la hoja. 
No se si es con botón derecho sobre el tab de la hoja, pero es que me parece que tengo algo metido allí ya.


----------



## Esgrimidor (Aug 20, 2009)

Greg Truby said:


> Actualmente, si usted pone el siguiente en el módulo para la hoja creo que se puede desocupar un poco de tener que correr UNSETKEYS().
> 
> 
> 
> ...




¿ Dónde pongo este código ?
¿ En el mismo sitio que puse el otro ?

Gracias


----------



## Greg Truby (Aug 21, 2009)

Esgrimidor said:


> ¿ Dónde pongo este código ?
> ¿ En el mismo sitio que puse el otro ?
> 
> Gracias


 
De Excel mismo (no del editor de VB) haz un cliq-derecho sobre la etiqueta de la hoja. En el menú contextual usted verá una opción como "View Code". Si usted selecciona ella le lleva directamente al módulo que corresonde a tal hoja. [También, una ruta alternative es escoger el módulo en el editor si tiene la ventana _Exploradora de Proyectos_ abierto con hacer cliq-doble sobre el nombre de la hoja.]


----------



## Jaafar Tribak (Aug 22, 2009)

Hola,

He aqui una adaptacion de un metodo que compuse ultimamente .

Copia el codigo siguiente en el modulo de la hoja (Worksheet module).Una vez copiado el codigo, cada vez que selecciones una celda en la columna F:F y le des a cualquier tecla (excepto aquellas para navigar la hoja) el simbolo ües automaticamente insertado en la celda activa y la selection pasa directamente a la celda siguiente.
Sin embargo, si la tecla "Enter" es golpeada la celda siguiente es activada sin insertar el simbolo.

Codigo : (Worksheet module)


```
Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type MSG
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
 
Private Declare Function WaitMessage Lib "user32" () As Long
 
Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
 
Private Declare Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long
 
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE  As Long = &H1
Private Const PM_NOREMOVE As Long = &H0
Private Const WM_CHAR    As Long = &H102
Private bExitLoop As Boolean
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    [COLOR=seagreen]'intercept user keystrokes within column F:F[/COLOR]
    If Union(Target, Columns("F:F")).Address = _
    Columns("F:F").Address Then
        StartKeyWatch
    Else
        StopKeyWatch
    End If
 
End Sub
 
Private Sub StartKeyWatch()
 
    Dim msgMessage As MSG
    Dim bCancel As Boolean
    Dim iKeyCode As Integer
    Dim lXLhwnd As Long
 
    [COLOR=seagreen]'handle the ESC key.[/COLOR]
    On Error GoTo errHandler:
    Application.EnableCancelKey = xlErrorHandler
  [COLOR=seagreen] 'initialize this boolean flag.[/COLOR]
    bExitLoop = False
    [COLOR=seagreen]'get the app hwnd.[/COLOR]
    lXLhwnd = FindWindow("XLMAIN", Application.Caption)
    Do
        WaitMessage
      [COLOR=seagreen]  'check for a key press and remove it from the msg queue.[/COLOR]
        If PeekMessage _
            (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
         [COLOR=seagreen]  'strore the virtual key code for later use.[/COLOR]
[COLOR=seagreen]          [COLOR=black]iKeyCode = msgMessage.wParam[/COLOR]
           'translate the virtual key code into a char msg.
[/COLOR]           TranslateMessage msgMessage
            PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
            WM_CHAR, PM_REMOVE
          [COLOR=seagreen] 'for some obscure reason, the following[/COLOR]
[COLOR=seagreen]         'keys are not trapped inside the event handler[/COLOR]
            [COLOR=seagreen]'so we handle them here.[/COLOR]
            If iKeyCode = vbKeyBack Then SendKeys "{BS}"
            If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
           [COLOR=seagreen]'assume the cancel argument is False.[/COLOR]
            bCancel = False
            [COLOR=seagreen]'the VBA RaiseEvent statement does not seem to return ByRef arguments[/COLOR]
            [COLOR=seagreen]'so we call a KeyPress routine rather than a propper event handler.[/COLOR]
            Sheet_KeyPress _
            ByVal msgMessage.wParam, ByVal iKeyCode, ByVal ActiveCell, bCancel
           [COLOR=seagreen]'if the key pressed is allowed post it to the application.[/COLOR]
            If bCancel = False Then
                PostMessage _
                lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
            End If
        End If
errHandler:
     [COLOR=seagreen]  'allow the processing of other msgs.[/COLOR]
        DoEvents
    Loop Until bExitLoop
 
End Sub
 
Private Sub StopKeyWatch()
 
   [COLOR=seagreen]'set this boolean flag to exit the above loop.[/COLOR]
    bExitLoop = True
 
End Sub
 
Private Sub Sheet_KeyPress _
(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, _
ByVal Target As Range, Cancel As Boolean)
 
   [COLOR=seagreen]'which key has been pressed ?[/COLOR]
    Select Case KeyCode
 
        Case vbKeyTab, _
             vbKeyReturn, _
             vbKeyLeft, _
             vbKeyUp, _
             vbKeyRight, _
             vbKeyDown, _
             vbKeyDelete[COLOR=seagreen] 'if it is a navigation key do nothing.[/COLOR]
        
 
        Case Else [COLOR=seagreen]'else,cancel the key stoke and _[/COLOR]
[COLOR=seagreen]                 'run these lines instead.[/COLOR]
            Cancel = True
            With Target
                .Value = "ü"
                .HorizontalAlignment = xlCenter
                .Font.Name = "Wingdings"
            End With
            SendKeys "{ENTER}"
 
    End Select
 
End Sub
```
 
Saludos cordiales.


----------



## Esgrimidor (Aug 23, 2009)

Greg Truby said:


> De Excel mismo (no del editor de VB) haz un cliq-derecho sobre la etiqueta de la hoja. En el menú contextual usted verá una opción como "View Code". Si usted selecciona ella le lleva directamente al módulo que corresonde a tal hoja. [También, una ruta alternative es escoger el módulo en el editor si tiene la ventana _Exploradora de Proyectos_ abierto con hacer cliq-doble sobre el nombre de la hoja.]



Muchas gracias Greg. Al principio parece que me fallaba al introducir el código : 

Option Explicit
Private Const mc_intCol As Integer = 7  ' only target column 7
Private Sub Worksheet_Activate()
    If ActiveCell.Column = mc_intCol Then
        SetKeys
    Else
        UnsetKeys
    End If
End Sub
Private Sub Worksheet_Deactivate()
    UnsetKeys
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = mc_intCol Then
        SetKeys
    Else
        UnsetKeys
    End If
End Sub

Pero insistiendo e introduciendo este código de hoja al principio de la ventana Ver Código que aparece con click derecho sobre la hoja afecta parece ir bien. En cambio si lo colocaba al final parece que no.
Es que tengo también ya metido algún otro código anterior de hoja.....

He salido de la hoja y vuelto a entrar y me sigue funcionando bien la macro. 

Muchas gracias. 

Seguiré con las pruebas y si hay alguna variación te lo cuento.


----------



## Esgrimidor (Aug 23, 2009)

Jaafar Tribak said:


> Hola,
> 
> He aqui una adaptacion de un metodo que compuse ultimamente .
> 
> ...



Muchas gracias Jaafar por tu aporte.


----------



## Esgrimidor (Aug 12, 2009)

Celda para un solo carácter con pase a siguiente sin esperas. 

¿ Cómo se configura una celda excel para que sólo sea posible meter un carácter y que tras introducirlo salte el cursor a la celda siguiente inferior ?

Por ejemplo el dígito 1 hace que se escriba el uno y luego el cursor pase a la celda inferior. Y si le damos a enter que pase a la celda siguiente sin escribir nada en la celda actual.


----------



## galileogali (Aug 25, 2009)

Juan Pablo: me resulto llamativo un uso que haces concretamente:

rng.WorkSheet.Cells(.......

¿¿¿¿es realmente un equivalente de:

rng.Parent.Cells(......????


----------



## Esgrimidor (Aug 25, 2009)

galileogali said:


> Juan Pablo: me resulto llamativo un uso que haces concretamente:
> 
> rng.WorkSheet.Cells(.......
> 
> ...



Encantado de verte por aquí Galileo. Precisamente proyecto un viajecito para verte casi inmediatamente.


----------

