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