Se ha producido el error '1004' en tiempo de ejecución
publicado
Hola amigos:
Tengo el siguiente código:
Public Buscarhoja As String
Private Sub UserForm_Initialize() 'Al iniciar el userform
Application.Visible = False 'Ocultar la Aplicación Excel
End Sub
Private Sub UserForm_Terminate() 'Al cerrar el userform
Application.Visible = True 'Mostrar la Aplicación Excel
End Sub
Private Sub UserForm_Activate()
'cargar número
TextBox20 = Sheets("EXTRAS").Range("O1") + 1
'Cargar combobox
ComboBox1.RowSource = "FP"
ComboBox4.RowSource = "LA"
ComboBox5.RowSource = "EP"
p = Sheets("CLIENTES").Range("C1").End(xlDown).Row
ComboBox2.RowSource = "CLIENTES!D2:D" & p
End Sub
Private Sub TextBox1_Change()
'Formato de fecha
End Sub
Private Sub ComboBox1_Enter()
ComboBox1.BackColor = vbYellow
End Sub
Private Sub TextBox18_Enter()
TextBox18.BackColor = vbYellow
End Sub
Private Sub ComboBox2_Enter()
ComboBox2.BackColor = vbYellow
End Sub
Private Sub ComboBox2_Change()
'cargamos los datos
Dim busq As Range
On Error GoTo o
Set busq = Sheets("CLIENTES").Cells.Find(ComboBox2, lookat:=xlWhole)
ComboBox3 = busq.Offset(0, -1)
Exit Sub
o: ComboBox3 = ""
End Sub
Private Sub ComboBox3_Enter()
ComboBox3.BackColor = vbYellow
End Sub
Private Sub ComboBox4_Enter()
ComboBox4.BackColor = vbYellow
End Sub
Private Sub ComboBox4_change()
'Carga textbox segun combobox
Set b = Sheets("EXTRAS").Range("H:H").Find(ComboBox4)
If Not b Is Nothing Then
TextBox2 = Sheets("EXTRAS").Range("I" & b.Row)
End If
End Sub
Private Sub TextBox2_Enter()
TextBox2.BackColor = vbYellow
End Sub
Private Sub TextBox3_Enter()
TextBox3.BackColor = vbYellow
End Sub
Private Sub TextBox4_Enter()
TextBox4.BackColor = vbYellow
End Sub
Private Sub TextBox5_Enter()
TextBox5.BackColor = vbYellow
End Sub
Private Sub TextBox6_Enter()
TextBox6.BackColor = vbYellow
End Sub
Private Sub TextBox7_Enter()
TextBox7.BackColor = vbYellow
End Sub
Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox7.BackColor = vbWhite
End Sub
Private Sub TextBox8_Enter()
TextBox8.BackColor = vbYellow
End Sub
Private Sub TextBox19_Change()
'Formato de fecha
Private Sub TextBox19_Enter()
'Cambia fondo
TextBox19.BackColor = vbYellow
End Sub
Private Sub TextBox9_Enter()
TextBox9.BackColor = vbYellow
End Sub
Private Sub TextBox10_Enter()
TextBox10.BackColor = vbYellow
End Sub
Private Sub TextBox11_Enter()
TextBox11.BackColor = vbYellow
End Sub
Private Sub TextBox12_Enter()
TextBox12.BackColor = vbYellow
End Sub
Private Sub TextBox12_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox12.Value = Format(Val(TextBox12), "#,##0.00")
TextBox12.BackColor = vbWhite
End Sub
Private Sub TextBox13_Enter()
TextBox13.BackColor = vbYellow
End Sub
Private Sub TextBox14_Enter()
TextBox14.BackColor = vbYellow
End Sub
Private Sub TextBox15_Enter()
suma = CDbl(TextBox13) + CDbl(TextBox14) 'suma de dos textbox
TextBox15 = Format(suma, "0.00")
'suma = Val(TextBox13.Text) + Val(TextBox14.Text)
'TextBox15.Text = Str(suma)
TextBox15.BackColor = vbYellow
End Sub
Private Sub ComboBox5_Enter()
ComboBox5.BackColor = vbYellow
End Sub
Private Sub ComboBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox5.BackColor = vbWhite
End Sub
Private Sub TextBox16_Enter()
TextBox16.BackColor = vbYellow
End Sub
Private Sub TextBox16_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox16.BackColor = vbWhite
End Sub
Private Sub TextBox17_Enter()
TextBox17.BackColor = vbYellow
End Sub
Private Sub CommandButton1_Click() ': On Error GoTo HayErrores
'verificar si boleto esta duplicado
dato = TextBox3.Value
contarsi = Application.WorksheetFunction.CountIf(Sheets("BOLETOS").Columns("I:I"), dato)
If contarsi > 1 Then
MsgBox "El boleto ya existe, no se permite duplicado"
TextBox3.SetFocus
Else
'registrodeboleto
'Numerador
TextBox20 = Val(TextBox20) + 1
TextBox20 = Sheets("EXTRAS").Range("O1") + 1
Sheets("EXTRAS").Select
ActiveSheet.Unprotect Password:="jmp"
Sheets("EXTRAS").Range("O1") = Sheets("EXTRAS").Range("O1") + 1
ActiveSheet.Protect Password:="jmp"
Application.ScreenUpdating = False
'ahora a pasar a su karkex
'establezco en qué libro volcar los datos, según la letra inicial del combo
Librok = "CuentasporcobrarTT.xlsm"
hojita = ComboBox3.Value
Workbooks(Librok).Sheets(hojita).Cells(a7).End(xlDown).Select
ActiveSheet.Range("A7").End(xlDown).Select
'busco la primer fila libre en libro destino
libre = Workbooks(Librok).Sheets(hojita).Range("A7").End(xlDown).Row + 1
'comienza el pase - ajustar
Workbooks(Librok).Sheets(hojita).Cells(libre, 1).Rows(Row + 1).Selection.EntireRow.Insert
Workbooks(Librok).Sheets(hojita).Cells(libre, 1).Value = CDate(TextBox1.Text) 'fecha
Workbooks(Librok).Sheets(hojita).Cells(libre, 2).Value = ComboBox4.Text 'la
Workbooks(Librok).Sheets(hojita).Cells(libre, 3).Value = TextBox2.Text 'cod
Workbooks(Librok).Sheets(hojita).Cells(libre, 4).Value = TextBox3.Text 'tkt
Workbooks(Librok).Sheets(hojita).Cells(libre, 5).Value = TextBox4.Text 'r1
Workbooks(Librok).Sheets(hojita).Cells(libre, 6).Value = TextBox5.Text 'r2
Workbooks(Librok).Sheets(hojita).Cells(libre, 7).Value = TextBox6.Text 'r3
Workbooks(Librok).Sheets(hojita).Cells(libre, 8).Value = TextBox7.Text 'r4
Workbooks(Librok).Sheets(hojita).Cells(libre, 9).Value = TextBox8.Text 'r5
Workbooks(Librok).Sheets(hojita).Cells(libre, 10).Value = TextBox9.Text 'pax
Workbooks(Librok).Sheets(hojita).Cells(libre, 11).Value = CDbl(TextBox12.Text) 'tt BS
Workbooks(Librok).Sheets(hojita).Cells(libre, 12).Value = CDbl(TextBox15.Text) 'tt $US
End If
Application.ScreenUpdating = True
End Sub
[/CODE]
[b]Bueno al momento de ejecutar la macro me sale el siguiente error:[/b]
Se ha producido el error '1004' en tiempo de ejecución:
Error definido por la aplicación o el objeto
Ayuudddddaaaaa por favorrrr, esta macro es de vital importancia para mi persona
Gracias por su tiempo y colaboración, reciban cordiales saludo
Atentamente,
Jesús
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Hola amigos:
Tengo el siguiente código:
[b]Bueno al momento de ejecutar la macro me sale el siguiente error:[/b]
Se ha producido el error '1004' en tiempo de ejecución:
Error definido por la aplicación o el objeto
Ayuudddddaaaaa por favorrrr, esta macro es de vital importancia para mi persona
Gracias por su tiempo y colaboración, reciban cordiales saludo
Atentamente,
Jesús