Cuando incorporaste el ocultar la hoja de excel
Al ocultar la hoja de excel la macro se ejecuta desde otra hoja, entonces al guardar los datos me los guarda en esa hoja nueva ... No en la hoja que esta oculta...
1 Respuesta
Respuesta de Dante Amor
1
Lo último de form listar
Dim h1
'
Private Sub CommandButton1_Click()
'filtra por fechas
If h1.AutoFilterMode Then h1.AutoFilterMode = False
ListBox1.Clear
If ComboBox1.Value = "" Then
MsgBox "Seleccione una Fecha 'DESDE'"
Exit Sub
End If
fec1 = CDate(ComboBox1.Value)
If ComboBox2 = "" Then
fec2 = fec1
Else
fec2 = CDate(ComboBox2.Value)
End If
'
u = h1.Range("E" & Rows.Count).End(xlUp).Row
For i = 3 To u
lafecha = h1.Cells(i, "E").Value
If h1.Cells(i, "E").Value >= fec1 And h1.Cells(i, "E") <= fec2 Then
ListBox1. AddItem h1.Cells(i, "A")
ListBox1. List(ListBox1.ListCount - 1, 1) = h1.Cells(i, "B")
ListBox1. List(ListBox1.ListCount - 1, 2) = h1.Cells(i, "C")
ListBox1. List(ListBox1.ListCount - 1, 3) = h1.Cells(i, "D")
ListBox1. List(ListBox1.ListCount - 1, 4) = h1.Cells(i, "E")
ListBox1. List(ListBox1.ListCount - 1, 5) = Format(h1.Cells(i, "F"), "hh:mm")
ListBox1. List(ListBox1.ListCount - 1, 6) = Format(h1.Cells(i, "G"), "hh:mm")
ListBox1. List(ListBox1.ListCount - 1, 7) = h1.Cells(i, "H")
End If
Next
End Sub
'
Private Sub CommandButton5_Click()
' Por Dante Amor
'
'Filtra por turno
If h1.AutoFilterMode Then h1.AutoFilterMode = False
ListBox1.Clear
If ComboBox3.Value = "" Then
MsgBox "Seleccione un Turno"
Exit Sub
End If
If ComboBox1.Value = "" Then
fec1 = ""
Else
fec1 = CDate(ComboBox1.Value)
End If
If ComboBox2 = "" Then
fec2 = fec1
Else
fec2 = CDate(ComboBox2.Value)
End If
'
u = h1.Range("E" & Rows.Count).End(xlUp).Row
lamisma = False
For i = 3 To u
lafecha = h1.Cells(i, "E").Value
If fec1 = "" Then fec1 = h1.Cells(i, "E"): lamisma = True
If fec2 = "" Then fec2 = h1.Cells(i, "E")
If h1.Cells(i, "E").Value >= fec1 And h1.Cells(i, "E") <= fec2 And _
h1.Cells(i, "A") = ComboBox3.Value Then
ListBox1. AddItem h1.Cells(i, "A")
ListBox1. List(ListBox1.ListCount - 1, 1) = h1.Cells(i, "B")
ListBox1. List(ListBox1.ListCount - 1, 2) = h1.Cells(i, "C")
ListBox1. List(ListBox1.ListCount - 1, 3) = h1.Cells(i, "D")
ListBox1. List(ListBox1.ListCount - 1, 4) = h1.Cells(i, "E")
ListBox1. List(ListBox1.ListCount - 1, 5) = Format(h1.Cells(i, "F"), "hh:mm")
ListBox1. List(ListBox1.ListCount - 1, 6) = Format(h1.Cells(i, "G"), "hh:mm")
ListBox1. List(ListBox1.ListCount - 1, 7) = h1.Cells(i, "H")
End If
If lamisma Then
fec1 = ""
fec2 = ""
End If
Next
End Sub
'
Private Sub CommandButton2_Click()
'Exporta
'MsgBox "RECUERDE: Solo un PDF a la vez"
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u = h1.Range("F" & Rows.Count).End(xlUp).Row
f1 = Format(ComboBox1.Value, "mm/dd/yyyy")
If ComboBox2.Value = "" Then
f2 = f1
Else
f2 = Format(ComboBox2.Value, "mm/dd/yyyy")
End If
'
ruta = ThisWorkbook.Path & "\"
arch = "BitacoraMantencion"
prefijo = ""
ver = ""
ext = ".pdf"
una = True
Do While True
If Dir(ruta & arch & prefijo & ver & ext) <> "" Then
prefijo = "_v"
If una Then
ver = 1
una = False
Else
ver = ver + 1
End If
Else
Exit Do
End If
Loop
'
If ComboBox1 <> "" Then
h1.Range("$A$2:$H$" & u).AutoFilter Field:=5, Criteria1:= _
">=" & f1, Operator:=xlAnd, Criteria2:="<=" & f2
End If
If ComboBox3 <> "" Then
h1.Range("$A$2:$H$" & u).AutoFilter Field:=1, Criteria1:= _
"=" & ComboBox3
End If
Application.ScreenUpdating = False
h1.Visible = True
h1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & arch & prefijo & ver & ext, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
h1.Visible = False
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton4_Click()
'exportar a hoja
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
ruta = ThisWorkbook.Path & "\"
arch = ActiveSheet.Name
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Copy
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
f1 = CDate(ComboBox1.Value)
If ComboBox2.Value = "" Then
f2 = f1
Else
f2 = CDate(ComboBox2.Value)
End If
'
For i = u To 3 Step -1
If h2.Cells(i, "E") >= f1 And h2.Cells(i, "E") <= f2 Then
Else
h2.Rows(i).Delete
End If
Next
On Error Resume Next
h2.DrawingObjects("Button 1").Delete
On Error GoTo 0
l2.SaveAs Filename:=ruta & arch & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
l2.Close
MsgBox "Base de datos guardada en ESCRITORIO"
End Sub
'
Private Sub UserForm_Activate()
Set h1 = Sheets("Ingresar")
If h1.AutoFilterMode Then h1.AutoFilterMode = False
For i = 3 To h1.Range("E" & Rows.Count).End(xlUp).Row
Call Agregar(ComboBox1, h1.Cells(i, "E").Value)
Call Agregar(ComboBox2, h1.Cells(i, "E").Value)
Call Agregar(ComboBox3, h1.Cells(i, "A").Value)
Next
End Sub
'
Sub Agregar(combo As ComboBox, dato As String)
For i = 0 To combo.ListCount - 1
Select Case StrComp(combo.List(i), dato, vbTextCompare)
Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega
Case 1: combo.AddItem dato, i: Exit Sub 'Es menor, lo agrega antes del comparado
End Select
Next
combo.AddItem dato 'Es mayor lo agrega al final
End Sub
'
Private Sub TXTATRAS_Click()
Unload Me
End Subsal u dos, r ecuerda valorar las respuestas.
