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

1 Respuesta

Respuesta
1

Enviame tu libro para que revise el tema de la HOja5 que es la que presenta el error. Y comentame en qué versión Excel estás trabajando.

Mis correos aparecen en la portada del sitio que dejo al pie.

*

¡Gracias! Elsa te envíe el libro, espero lo hayas recibido. Estaré atento atus comentarios. Saludos.

Si, pero te respondí diciendo que desde el link no lo puedo abrir. Enviamelo por mail, como adjunto.

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas