Como crear botón siguiente del cuestionario
Para Dante Amor
¿Dan cómo seria el botón para avanzar en las preguntas del cuestionario?
1 respuesta
Respuesta de Dante Amor
1
Q u e Tal:
Te anexo la macro para el siguiente
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Act.Por.Dante Amor
'ActiveWindow.DisplayVerticalScrollBar = False
'ActiveWindow.DisplayHorizontalScrollBar = False
'ExecuteExcel4Macro ("show.toolbar(""ribbon"",1)")
If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
cantidad = InputBox("Si estás seguro, captura la cantidad:", "Seleccionaste: " & Range("B" & Target.Row))
If cantidad = 0 Or cantidad = "" Then Exit Sub
'
fecha = InputBox("Ingresa fecha: ")
If fecha = 0 Or fecha = "" 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 "Ya no hay filas para ingresar productos.", vbCritical, "ERROR"
Exit Sub
End If
h1.Unprotect "28021990"
h1.Cells(i, "I") = cantidad & " " & Cells(Target.Row, "B") 'Cantidad y producto
h1.Cells(i, "L") = fecha 'Fecha
h1.Cells(i, "F") = Cells(Target.Row, "C") * cantidad 'Cantidad * precio
h1.Protect "28021990"
End SubS a l u d o s .
Perdona, me equivoqué de macro
Private Sub CommandButton3_Click()
'Por.Dante Amor
'Siguiente
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
u = h2.Range("A" & Rows.Count).End(xlUp).Row
If u = 1 And h2.Cells(u, "A") = "" Then
MsgBox "No hay registros a mostrar", vbCritical, "SIGUIENTE"
Exit Sub
End If
'
If Label1 <> "" Then
If h2.[Y1] = "" Then
h2.[Y1] = Val(Label1)
End If
End If
nva = False
'
Set b = h2.Columns("X").Find("X", lookat:=xlWhole)
If Not b Is Nothing Then
If b.Row = u Then
ant = u
nva = True
h2.Columns("X").ClearContents
cuenta = Application.Count(h2.Columns("A"))
If cuenta < 5 Then
MsgBox "Pregunta final, se pasa a una nueva pregunta", vbExclamation, "SIGUIENTE"
Else
nva = False
MsgBox "Pregunta final, ya se concluyeron las preguntas", vbExclamation, "SIGUIENTE"
End If
Else
ant = b.Row + 1
h2.Cells(b.Row, "X") = ""
h2.Cells(ant, "X") = "X"
End If
Else
h2.Cells(1, "X") = "X"
ant = 1
End If
limpiar
If nva Then
y = h2.[Y1]
h2.[Y1] = ""
Else
y = h2.Cells(ant, "A")
End If
'Toma la pregunta para mostrarla en el label
Set b = h1.Columns("A").Find(y, lookat:=xlWhole)
If Not b Is Nothing Then
Label1 = h1.Cells(b.Row, "A")
Label2 = h1.Cells(b.Row, "B")
Label3 = h1.Cells(b.Row + 1, "B")
For i = b.Row + 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") <> "" Then Exit For
ListBox1.AddItem h1.Cells(i, "B")
Next
If nva = False Then
For i = 0 To ListBox1.ListCount - 1
If h2.Cells(ant, i + 2) = "X" Then
ListBox1.Selected(i) = True
End If
Next
End If
End If
'Poner foto
PonerFoto h1, Val(Label1)
End SubS a l u d o s .
