............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

hacer que control calendar inserte: >=30230

Ver el tema anterior Ver el tema siguiente Ir abajo

hacer que control calendar inserte: >=30230

Mensaje por rodolfo.ulloa.9 el Jue Mar 21, 2013 11:52 pm

buenas a todos estoy buscando la forma de hacer que un control calendar inserte la fecha en valor numerico pero con el mayor igual y menor igual

ejemplo:

se presiona sobre la celda "C8", se abre el calendario se selecciona fecha e inserta >=431210 (fecha seleccionada) en la celda "C2" y en la celda "C8" se inserta la fecha normal 4/2/2013

se presiona sobre la celda "E8", se abre el calendario se selecciona fecha e inserta <=431230 (fecha seleccionada) en la celda "D2" y en la celda "E8" se inserta la fecha normal 30/3/2013

este codigo del control calendar, lo que hace es que por medio de la variable quien identifica desde donde a sido llamado para insertar la fecha sea en un formulario o en una celda

Código:
Private Sub Calendar_Click()
    If Quien = 1 Then
    FmJornada.TextFecha = Calendar.Value
    ElseIf Quien = 2 Then
    FmNewEmp.TextFecha = Calendar.Value
    ElseIf Quien = 3 Then
    FmModEmp.TextFecha = Calendar.Value
    ElseIf Quien = 4 Then
    Range("B8") = Calendar.Value
    ElseIf Quien = 5 Then
    Range("D8") = Calendar.Value
    ElseIf Quien = 6 Then
    Range("C8") = Calendar.Value
    ElseIf Quien = 7 Then
    Range("E8") = Calendar.Value
    End If
    Unload FmCalendario
    End Sub

este codigo es del filtro fecha que esta en un modulo, no se muy bien como funciona ya que este filtro lo copie y es el que me funciono sin muchos problemas con los criterios de fechas

Código:
 Sub Filtro_fechas(celda As String, signo As String)
    x = InStr(Range(celda).Value, signo)
    y = InStr(Range(celda).Value, "=")
    'f_i fecha_inicial
    f_i = Range(celda).Value
    If x = 1 And y = 2 Then
    'esto es para determinar si estamos usando un >= o <=
    Range(celda).Value = signo & "=" & Format(CDate(Mid(f_i, y + 1, Len(f_i) - y)), 0)
    End If
    If x = 1 And y = 0 Then
    Range(celda).Value = signo & Format(CDate(Mid(f_i, x + 1, Len(f_i) - x)), 0)
    End If
    End Sub

y este es el codigo que esta en la hoja, este codigo limpia busca la ultima fila del resultado del filtro e inserta los totales y las lineas y luego una linea con el texto de firma de empleado y ademas cambia la fecha al ser insertada por el calendario

Código:
 Private Sub Worksheet_Change(ByVal Target As Range)
    Z = Hoja2.Range("I500000").End(xlUp).Row
    If Not Intersect(Target, Range("C2:E2")) Is Nothing Then
    'para que no se vuelva a ejecutar
    Application.EnableEvents = False
    'limpio la hoja de datos anteriores y quito bordes. Sumo 6 para cubrir la zona de firma
    Range("A11:I" & Range("I65000").End(xlUp).Row + 6).Select
    With Selection
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    Range("A11:I" & Range("I65000").End(xlUp).Row + 6).ClearContents
    'filtra
    Hoja2.Range("A5:I" & Z).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("C1:E2"), CopyToRange:=Range("A10:I10"), Unique:=False

    ultima = Range("F900000").End(xlUp).Row
    Range("D" & ultima + 1) = "TOTAL"
    Range("E" & ultima + 1).FormulaR1C1 = "=SUM(R11C:R[-1]C)"
    Range("F" & ultima + 1).FormulaR1C1 = "=SUM(R11C:R[-1]C)"
    Range("G" & ultima + 1).FormulaR1C1 = "=SUM(R11C:R[-1]C)"
    Range("H" & ultima + 1).FormulaR1C1 = "=SUM(R11C:R[-1]C)"
    Range("I" & ultima + 1).FormulaR1C1 = "=SUM(R11C:R[-1]C)"
    Range("G" & ultima + 6) = "Firma Empleado"
    Range("D" & ultima & ":I" & ultima).Select
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    Range("D" & ultima + 1 & ":I" & ultima + 1).Select
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    Range("G" & ultima + 5).Select
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    Application.EnableEvents = True
    End If
    End Sub
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address(False, False) = "C2" Then
    If Range("C2").Value = "" Then
    Application.SendKeys (">=")
    End If
    End If
    If Target.Address(False, False) = "D2" Then
    If Range("D2").Value = "" Then
    Application.SendKeys ("<=")
    End If
    End If
    If Target.Address(False, False) = "C3" Then
    Call Filtro_fechas("C2", ">")
    End If
    If Target.Address(False, False) = "D3" Then
    Call Filtro_fechas("D2", "<")
    End If
    If Union(Target, Range("I8")).Address = Range("I8").Address Then
    FmUbicacion.Show
    ElseIf Union(Target, Range("C8")).Address = Range("C8").Address Then
    Quien = 6
    FmCalendario.Show
    ElseIf Union(Target, Range("E8")).Address = Range("E8").Address Then
    Quien = 7
    FmCalendario.Show
    End If
    End Sub

yo no tengo mucho conocimiento aun tengo que buscar macros y copiar para aprender su funcionamiento, por eso agradeceria muchisimo sus concejos y ayudas

rodolfo.ulloa.9

Masculino Cantidad de envíos : 1
Edad : 32
Ciudad - Pais : csan jose
Version de Excel : 2003-2007-2010
Fecha de inscripción : 21/03/2013

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.