La Pregunta 2

30/08/2005 - 21:05 por Hermano2 | Informe spam
Bueno, para contestarte HECTOR MIGUEL, esto es solo para introducir datos
para pasarlo a otros 2 programas, por lo cual necesito que sea como mas o
menos te estoy explicando... ya que usaba otro programa pero no me dejaba
hacerlos muy bien, al descubrir que el Excel te deja guardar como DBF.

La pregunta que quiero hacer es la siguiente:

esto es asi, el D y E son D=Cobrado y E=Pagado, lo que quiero es que cuando
no le introduzco nada a alguno de los 2 me ponga 0 (cero) solo en D y E, y el
error que tengo es cuando no pongo nada en B, D y/o E, se desplace hacia la
derecha, porque si no pongo nada en alguno de los 3 se desplaza hacia ABAJO
:(

el codigo:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("a2:e2000")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Count > 1 Then ActiveCell.Select
If ActiveCell.Column > 1 Then GoTo Salida
If IsEmpty(ActiveCell) Then GoTo Salida
ActiveCell.NumberFormat = "General"
ActiveCell = CLng(Format(ActiveCell, "ddmmyy"))
SendKeys "{F2}+{Home}"
Salida:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:e2000")) Is Nothing Then Exit Sub
If Target.Column = 5 Then If Not IsEmpty(Target.Offset(1, -4)) _
Then Cells(Target.Row + 1, 2).Select: Exit Sub
If Target.Column > 1 Then GoTo Salta
Application.EnableEvents = False
Target = DateSerial(Right(Target, 2), Mid(Target, 3, 2), Left(Target, 2))
Target.NumberFormat = "d/mm/yyyy"
Application.EnableEvents = True
Salta:
With Target
If .Row = 2000 And .Column = 5 Then Range("b2").Select: Exit Sub
Cells(.Row + IIf(.Column = 5, _
IIf(.Row = 2000, -1998, 1), 0), _
.Column + IIf(.Column = 5, -4, 1)).Select
End With
End Sub

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
31/08/2005 - 07:50 | Informe spam
hola, Hermano2 !

... esto es solo para introducir datos para pasarlo a otros 2 programas
... necesito que sea como mas o menos te estoy explicando
... D=Cobrado y E=Pagado... cuando no le introduzco nada a alguno de los 2 me ponga 0
... y el error que tengo es cuando no pongo nada en B, D y/o E... se desplaza hacia ABAJO



la causa del comportamiento que describes es la caracteristica de 'mover seleccion despues del enter' :))
[menu] herramientas / [ficha] modificar / [seccion] configuracion -> mover seleccion... Y direccion :(
[ademas] ES una carcteristica ->opcional<- de la configuracion de cada usuario/pc [tu la estas usando] ;)

el codigo 'ha sufrido' de algunos cambios [y una 'ligera crecidita'] :D
utilizando el evento '_open' para detectar Y RESTABLECER dicha caracteristica [solo por si las...] :))

corre pruebas y... comentas?
saludos,
hector.
en el modulo de codigo del libro [ThisWorkbook] ==Dim MoverSeleccion As Boolean, Direccion
Private Sub Workbook_Open()
MoverSeleccion = Application.MoveAfterReturn
If MoverSeleccion Then Direccion = Application.MoveAfterReturnDirection
Application.MoveAfterReturn = True
Application.MoveAfterReturnDirection = xlToRight
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.MoveAfterReturn = MoverSeleccion
If MoverSeleccion Then Application.MoveAfterReturnDirection = Direccion
End Sub

== en el modulo de codigo de 'esa' hoja ==Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("a2:e2000")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Count > 1 Then ActiveCell.Select
If ActiveCell.Column > 1 Then GoTo Salida
If IsEmpty(ActiveCell) Then GoTo Salida
If ActiveCell.NumberFormat = "@" Then GoTo Salida
ActiveCell.NumberFormat = "@"
ActiveCell = Right("000000" & CLng(Format(ActiveCell, "ddmmyy")), 6)
Salida:
Application.EnableEvents = True
If ActiveCell.Column = 1 Then _
If IsEmpty(ActiveCell.Offset(-1, 4)) Then ActiveCell.Offset(-1, 4) = 0
If ActiveCell.Column > 1 Then _
If Not IsEmpty(Cells(ActiveCell.Row, 1)) Then _
If Cells(ActiveCell.Row, 1).NumberFormat = "@" Then _
Worksheet_Change Cells(ActiveCell.Row, 1)
If ActiveCell.Column = 5 Then
If IsEmpty(ActiveCell.Offset(, -1)) Then ActiveCell.Offset(, -1) = 0
SendKeys "{f2}"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:e2000")) Is Nothing Then Exit Sub
If Target.Column > 1 Then GoTo Salta
If IsEmpty(Target) Then GoTo Salta
Application.EnableEvents = False
Target.NumberFormat = "d/mm/yyyy"
Target = DateSerial(Right(Target, 2), Mid(Target, 3, 2), Left(Target, 2))
Application.EnableEvents = True
Salta:
With Target
If .Row = 2000 And .Column = 5 Then Range("b2").Select: Exit Sub
Cells(.Row + IIf(.Column = 5, _
IIf(.Row = 2000, -1998, 1), 0), _
.Column + IIf(.Column = 5, -4, 1)).Select
End With
End Sub
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida