Insertar fecha >=301230 con control calendar desde userform VBA

buenas expertos, uso excel 2010, necesito su ayuda en el tema de VBA

objetivo: insertar fecha desde un control calendar que esta en un userform, en la celda de criterios, en modo numerico con los signos de mayor igualo 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

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

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

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
'End If 'aqui no xq debe ejecutar todavía todo el resto
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
En

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

Añade tu respuesta

Haz clic para o