Modificación de código copia y pegar (hecho por un experto)

Tengo este código hecho por el experto DAN

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
'ActiveWindow.DisplayVerticalScrollBar = False
'ActiveWindow.DisplayHorizontalScrollBar = False
'ExecuteExcel4Macro ("show.toolbar(""ribbon"",1)")
If Intersect(Target, Range("j7:j920,v7:v920,ah7:ah920,at7:at920,bf7:bf920,br7:br920,cd7:cd920,CP7:CP920,DB7:DB920,DN7:DN920,DZ7:DZ920,EL7:EL920,EX7:EX920,FJ7:FJ920")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Not IsNumeric(Target) Then Exit Sub
'
Set h1 = Sheets("REP X TURNO")
existe = False
For i = 10 To 23
If h1.Cells(i, "I") = "" Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "Limite de Degustaciones Alcanzado", vbCritical, "ERROR"
Exit Sub
End If
cantidad = Application.InputBox("Cantidad a Degustar: ", "Ingresar", Target)
If cantidad = 0 Or cantidad = "" Then Exit Sub
'
fecha = Application.InputBox("fecha de Degustación: ", "INGRESAR", Format(Cells(965, Target.Column), "MM/DD/yyyy"))
If fecha = 0 Or fecha = "" Then Exit Sub
'
h1.Unprotect
h1.Cells(i, "I") = cantidad & " " & Cells(Target.Row, "B") 'Cantidad y producto
h1.Cells(i, "J") = fecha 'Fecha
h1.Cells(i, "K") = Cells(Target.Row, "C") * cantidad 'Cantidad * precio
h1.Protect
End Sub

Funciona a la perfección

Pero en mi libro que tengo necesito que se le agregue 2 detalles no se si sea posible.

El 1ero es que cuando yo le ponga numero ejem: 100 ala celda "J10" y le doy ENTER o las flechitas

El cursor se mueve osea

Si doy ENTER pasa a J11 (conserva el valor 100 que puse en el imputbox) y si muevo la flechita sale =$K$11 en el imputbox (este depende hacia donde me mueva y ya no sale mi valor :C).

No se si se pueda quedar fijo la celda en que me posiciono ejemplo:

Si estoy en "J10" ya sea ENTER o FLECHITAS este siempre me reedireccione a "J10" que es donde tengo mi valor y así no perderlo en el imputbox... Creo que eso funcionaria...

Y el 2DO es que cuando yo ponga cantidad en alguna de celdas especificas y salgan los 2 imputbox FECHA y CANTIDAD si le doy cancelar a cualquiera de los 2 entonces me BORRE la cantidad que previamente puse en la celda que se activo para llamar a los imputbox..

1 respuesta

Respuesta
1

 H o l a:

Te anexo la macro actualizada

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    'ActiveWindow.DisplayVerticalScrollBar = False
    'ActiveWindow.DisplayHorizontalScrollBar = False
    'ExecuteExcel4Macro ("show.toolbar(""ribbon"",1)")
    If Intersect(Target, Range("j7:j920,v7:v920,ah7:ah920,at7:at920,bf7:bf920,br7:br920,cd7:cd920,CP7:CP920,DB7:DB920,DN7:DN920,DZ7:DZ920,EL7:EL920,EX7:EX920,FJ7:FJ920")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    '
    Target.Select
    Set h1 = Sheets("REP X TURNO")
    existe = False
    For i = 10 To 23
        If h1.Cells(i, "I") = "" Then
            existe = True
            Exit For
        End If
    Next
    If existe = False Then
        MsgBox "Limite de Degustaciones Alcanzado", vbCritical, "ERROR"
        Exit Sub
    End If
    cantidad = Application.InputBox("Cantidad a Degustar: ", "Ingresar", Target)
    If cantidad = 0 Or cantidad = "" Then
        Application.EnableEvents = False
        Target = ""
        Application.EnableEvents = True
        Exit Sub
    End If
    '
    fecha = Application.InputBox("fecha de Degustación: ", "INGRESAR", Format(Cells(965, Target.Column), "MM/DD/yyyy"))
    If fecha = 0 Or fecha = "" Then
        Application.EnableEvents = False
        Target = ""
        Application.EnableEvents = True
        Exit Sub
    End If
    '
    h1.Unprotect
    h1.Cells(i, "I") = cantidad & " " & Cells(Target.Row, "B") 'Cantidad y producto
    h1.Cells(i, "J") = fecha 'Fecha
    h1.Cells(i, "K") = Cells(Target.Row, "C") * cantidad 'Cantidad * precio
    h1.Protect
End Sub

 S a l u d o s

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas