Error en libro con macro en vba
Tengo un problema con esta macro cada ves que la agrego a un libro me sale este error " excel ha encontrado un archivo que no se puede leer " Registros quitados: Ordenación de /xl/worksheets/sheet5.xml parte, alguien me puede decir que tiene este código de mal que hace que aparezca este error a cada momento que se abra, a pesar que ya repare el libro . BUENO DESDE YA AGRADEZCO SU AYUDA
Dim Fila As Long
Dim EsModificación As Boolean
Dim EsEliminación As Boolean
Dim EsAñadir As Boolean
Dim tot As Double
Dim totaldocumento As Double
Private Sub Actualizar(): On Error Resume Next
If EsModificación = True Or EsEliminación = True Then
K = ListBox1.List(ListBox1.ListIndex, 0)
If K.ListIndex = -1 Then
MsgBox "Error interno. Dejar de trabajar con el programa."
Exit Sub
End If
Fila = K.ListIndex + 3
Else
Fila = Hoja5.Range("A" & Rows.Count).End(xlUp).Row + 1
End If
If EsEliminación = True Then
Rows(Fila).Delete
Exit Sub
End If
Range("A" & Fila) = CLng(C1)
Range("B" & Fila) = C2
Range("C" & Fila) = CLng(C3)
Range("D" & Fila) = C4
Range("E" & Fila) = CCur(C5)
'Range("F" & Fila) = CDate(C6)
End Sub
Private Sub C2_Change()
Filtrar
End Sub
Private Sub C3_Change()
Filtrar
End Sub
Private Sub C4_Change()
Filtrar
End Sub
Private Sub C5_Change()
Filtrar
End Sub
Private Sub C6_Change()
Filtrar
End Sub
Private Sub CommandButton1_Click()
Call suma
End Sub
Private Sub CommandButton2_Click()
Unload Me
UserForm4.Show
End Sub
Private Sub Guardar_Click()
Fila = Hoja8.Range("F" & Rows.Count).End(xlUp).Row + 1
For i = 0 To ListBox1.ListCount - 1
Hoja8.Cells(Fila, 1) = Me.ListBox1.List(i, 0) 'Empleado
Hoja8.Cells(Fila, 2) = Me.ListBox1.List(i, 1) 'Departamento
Hoja8.Cells(Fila, 3) = Me.ListBox1.List(i, 2)
Hoja8.Cells(Fila, 4) = Me.ListBox1.List(i, 3)
Hoja8.Cells(Fila, 5) = Me.ListBox1.List(i, 4)
'Hoja8.Range("A" & Fila) = ListBox1.List(i)
'Hoja8.Range("B" & Fila) = ListBox1.List(i)
'Hoja8.Range("C" & Fila) = ListBox1.List(i)
'Hoja8.Range("D" & Fila) = ListBox1.List(i)
Fila = Fila + 1
Next
Hoja8.Range("F" & Fila) = totaldocumento
Hoja8.Range("G" & Fila) = Date
Hoja8.Range("H" & Fila) = Time
Hoja8.Range("A" & Fila & ":H" & Fila).Interior.Color = vbYellow
Restaurar_Click
End Sub
Private Sub K_Change()
End Sub
Private Sub QuitarSelección_Click()
ListBox1.ListIndex = -1
Filtrar
QuitarSelección.Visible = False
End Sub
Private Sub Restaurar_Click()
Ordenado.ListIndex = 1
ListBox1.ListIndex = -1
Limpiar_Click
C2.SetFocus
QuitarSelección.Visible = False
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub txtcambio_Change()
FORMULA
End Sub
Private Sub txtefectivo_Change()
FORMULA
End Sub
Private Sub txtsuma_Change()
FORMULA
End Sub
Private Sub UserForm_Activate()
Limpiar_Click
Label4 = Date
Label5 = Time
C1.Enabled = False
C3.Enabled = False
C4.Enabled = False
C6.Enabled = False
'txtsuma.Enabled = False
'txtcambio.Enabled = False
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Hoja5.Select
CargarKey
For y = 1 To 6
Ordenado.AddItem Cells(1, y)
Next
Restaurar_Click
End Sub
Private Sub CargarKey()
K.RowSource = Hoja5.Name & "!A3:A" & Hoja5.Range("A" & Rows.Count).End(xlUp).Row
End Sub
Private Sub Filtrar(): On Error Resume Next
Dim A1, A2
If Not ListBox1.ListIndex = -1 Then Exit Sub
Application.ScreenUpdating = False
Hoja5.Range("A2:F2").ClearContents
ListBox1.RowSource = ""
A1 = "*"
A2 = "*"
For y = 2 To 6
TextBox1 = Controls("C" & y)
If TextBox1 <> "" Then
If IsNumeric(TextBox1) = True Then
Hoja5.Cells(2, y).value = CLng(TextBox1)
ElseIf IsDate(TextBox1) = True Then
Hoja5.Cells(2, y).value = CDate(TextBox1)
Else
Hoja5.Cells(2, y).value = CStr(A1 & TextBox1 & A2)
End If
End If
Next
'_____________________________________________
'
Hoja5.Select
Hoja5.Range("AA:AF").ClearContents
Hoja5.Range("A:F").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Hoja5.Range("A1:F2"), _
CopyToRange:=Hoja5.Range("AA1:AF1"), Unique:=False
Hoja5.Range("A2:F2").ClearContents
Range("AA2:AF2").Delete Shift:=xlUp
Ordenar
End Sub
Private Sub Ordenar(): On Error Resume Next
Application.ScreenUpdating = False
Hoja5.Select
Me.ListBox1.ColumnCount = 5
Me.ListBox1.ColumnWidths = "100 pt;180 pt;160pt;80pt;80pt"
Set RANGO = Hoja5.Range("AA2:AF" & Hoja5.Range("AA" & Rows.Count).End(xlUp).Row + 1)
RANGO.SortSpecial key1:=Hoja5.Columns(Ordenado.ListIndex + 27), _
key2:=Hoja5.Columns(28), Header:=xlGuess
ListBox1.RowSource = RANGO.Address
End Sub
Private Sub Limpiar_Click(): On Error Resume Next
Filtrar
C1 = Application.WorksheetFunction.Max(Hoja5.Range("A2:A" & Hoja5.Range("A" & Rows.Count).End(xlUp).Row)) + 1
For X = 2 To 6: Controls("C" & X) = "": Next
Aviso = "Listo para añadir un nuevo registro"
'Añadir.Visible = True
'Modificar.Visible = False
'ELIMINAR.Visible = False
C2.SetFocus
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
QuitarSelección.Visible = True
For X = 1 To 5: Controls("C" & X) = ListBox1.List(ListBox1.ListIndex, X - 1): Next
C5 = CDate(ListBox1.List(ListBox1.ListIndex, 4))
'Añadir.Visible = False
'Modificar.Visible = True
'ELIMINAR.Visible = True
'AvisoII = ""
'Aviso = "Listo para modificar o eliminar el registro seleccionado"
Call suma
End Sub
Private Sub Salir_Click()
Unload Me
End Sub
Private Sub Ordenado_Click()
Ordenar
End Sub
Private Sub UserForm_Terminate()
Hoja5.Range("AA:AM").Clear
End Sub
Private Sub suma()
'Dim i As Double
'For i = 0 To ListBox1.ListCount - 1
'tot = tot + CDbl(ListBox1.List(i, 4))
'Next i
' txtsuma = Format(tot, "0.00")
'Exit Sub
totaldocumento = 0
For i = 0 To ListBox1.ListCount - 1
totaldocumento = totaldocumento + CCur(ListBox1.List(i, 3))
Next i
txtsuma.Text = FormatNumber(totaldocumento)
End Sub
Private Sub FORMULA()
txtcambio.value = Format(CDbl(Val(txtefectivo)) - CDbl(Val(txtsuma)), "#,##0.00")
'txtsuma = Format(txtsuma.Text, "#,##0.00")
'txtefectivo = Format(txtefectivo.Text, "#,##,0.00")
End Sub