Hola amigo, alguien me puede ayudar a mejorar este codigo, el problema es que esta lenta la aplicación. saludos, Private Sub ACEPTAR_Click() Label17.Visible = False ACEPTAR.Visible = False End Sub Private Sub cambioid_Change() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Sheets("Hoja3").Visible = xlSheetVisible Sheets("Hoja3").Select ActiveSheet.Unprotect Range("A1").Select ActiveCell.FormulaR1C1 = cambioid.Value Range("B1").Select codigo = Range("b1").Value Range("C1").Select nombre = Range("C1").Value ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Sheets("Hoja3").Visible = xlSheetVeryHidden Sheets("Hoja1").Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub Private Sub codigo_Exit(ByVal Cancel As MSForms.ReturnBoolean) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False principal.nombre = "" With Worksheets("hoja3").Range("b3:c2000") Set c = .Find(codigo.Value, LookIn:=xlValues) If Not c Is Nothing Then principal.nombre.Value = c.Offset(0, 1) Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End If End With End Sub Private Sub codimaqui_Change() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Sheets("Hoja4").Visible = xlSheetVisible Sheets("Hoja4").Select ActiveSheet.Unprotect Range("A1").Select ActiveCell.FormulaR1C1 = codimaqui.Value Range("B1").Select maquina = Range("b1").Value Range("C1").Select nombremaqui = Range("C1").Value ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Sheets("Hoja4").Visible = xlSheetVeryHidden Sheets("Hoja1").Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub Private Sub cambioreg_Change() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Sheets("Hoja2").Visible = xlSheetVisible Sheets("Hoja2").Select Range("A1").Select ActiveCell.Offset(cambioreg.Value, 0).Select registro = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select fecha = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select codigo = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select nombre = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select maquina = ActiveCell.FormulaR1C1 Sheets("Hoja4").Visible = xlSheetVisible Sheets("Hoja4").Select ActiveSheet.Unprotect Range("D1").Select ActiveCell = maquina Sheets("Hoja4").Visible = xlSheetVeryHidden Sheets("Hoja2").Select ActiveCell.Offset(0, 1).Select problema = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select comentario = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select repuestos = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select horometro = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select templeado = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select numeroot = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select generarot = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, -11).Select Sheets("Hoja4").Visible = xlSheetVisible Sheets("Hoja4").Select Range("E1").Select nombremaqui = ActiveCell.Text Sheets("Hoja4").Visible = xlSheetVeryHidden Sheets("Hoja2").Visible = xlSheetVisible Sheets("Hoja1").Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub Private Sub maquina_Exit(ByVal Cancel As MSForms.ReturnBoolean) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Sheets("Hoja4").Visible = xlSheetVisible Sheets("Hoja4").Select ActiveSheet.Unprotect Range("D1").Select ActiveCell = maquina nombremaqui = Range("e1").Value Sheets("Hoja4").Visible = xlSheetVeryHidden Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub Private Sub CommandButton1_Click() Application.Visible = True End End Sub Private Sub CommandButton4_Click() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False ChDir "C:\Users\cndrorbes\Desktop\Bitacora" Workbooks.Open Filename:= _ "C:\Users\cndrorbes\Desktop\Bitacora\Exportar reporte novedades.xlsm" Windows("Bitacorav2.1.xlsm").Activate Range("A1:N10000").Select Selection.Copy Windows("Exportar reporte novedades.xlsm").Activate Sheets("Zona A").Select Range("A1").Select ActiveSheet.Paste Range("A1").Select Application.CutCopyMode = False ActiveWorkbook.Save ActiveWindow.Close ActiveWindow.LargeScroll ToRight:=-1 Range("A1").Select MsgBox "Finalizo la Expoprtación", vbInformation Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub Private Sub nuevo_Click() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False fecha = Now() maquina = "" problema = "" comentario = "" repuestos = "" horometro = "" templeado = "" numeroot = "" generarot = "" codigo = "" nombremaqui = "" Sheets("Hoja3").Visible = xlSheetVisible Sheets("Hoja3").Select Range("F2").Select registro = ActiveCell.FormulaR1C1 registro = registro + 1 ActiveSheet.Unprotect Range("A1").Select Range("B1").Select codigo = "" Range("C1").Select nombre = "" ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Sheets("Hoja3").Visible = xlSheetVeryHidden Sheets("Hoja1").Select salvar.Enabled = True nuevo.Enabled = False comentario.Locked = False repuestos.Locked = False horometro.Locked = False templeado.Locked = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub Private Sub salvar_Click() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False If codigo = "" Then Label17.Visible = True ACEPTAR.Visible = True Else If TextBox1 = "" Then Label17.Visible = True ACEPTAR.Visible = True Else If TextBox3 = "" Then Label17.Visible = True ACEPTAR.Visible = True Else If TextBox5 = "" Then Label17.Visible = True ACEPTAR.Visible = True Else If comentario = "" Then Label17.Visible = True ACEPTAR.Visible = True Else CONt = 0 linea1: CONt = CONt + 1 TextBox1.Enabled = False TextBox2.Enabled = True Sheets("Hoja2").Visible = xlSheetVisible Sheets("Hoja2").Select ActiveSheet.Unprotect Range("A1").Select ActiveCell.Offset(registro, 0).Select ActiveCell.FormulaR1C1 = registro ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = fecha ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = codigo ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = nombre ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = TextBox1 ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = TextBox2 ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = TextBox3 ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = TextBox4 ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = comentario ActiveCell.Offset(0, 1).Select ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = repuestos ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = horometro ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = templeado ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = TextBox5 ActiveCell.Offset(0, 1).Select Application.ScreenUpdating = False ChDir "C:\Users\cndrorbes\Desktop\Bitacora" Workbooks.Open Filename:= _ "C:\Users\cndrorbes\Desktop\Bitacora\Exportar reporte novedades.xlsm" Windows("Bitacorav2.1.xlsm").Activate Range("A1:N10000").Copy Windows("Exportar reporte novedades.xlsm").Activate Sheets("Zona A").Select Range("A1").Select ActiveSheet.Paste Range("A1").Select Application.CutCopyMode = False ActiveWorkbook.Save ActiveWindow.Close ActiveWindow.LargeScroll ToRight:=-1 Range("A1").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Sheets("Hoja2").Visible = xlSheetVisible Sheets("Hoja3").Visible = xlSheetVisible Sheets("Hoja3").Select ActiveSheet.Unprotect Range("F2").Select ActiveCell.FormulaR1C1 = registro ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Sheets("Hoja3").Visible = xlSheetVeryHidden Sheets("Hoja1").Select generarot = "" salvar.Enabled = False comentario.Locked = True repuestos.Locked = True horometro.Locked = True templeado.Locked = True TextBox1.Locked = True TextBox2.Locked = True TextBox3.Locked = True TextBox4.Locked = True TextBox5.Locked = True nuevo.Enabled = True ActiveWorkbook.Save If CONt = 1 Then GoTo linea1 Else End If If nuevo.Enabled = True Then maquina = "" problema = "" horometro = "" templeado = "" codigo = "" nombremaqui = "" nombre = "" TextBox1 = "" TextBox2 = "" TextBox3 = "" TextBox4 = "" TextBox5 = "" comentario = "" repuestos = "" Else ActiveWorkbook.Save Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End If End If End If End If End If End If End Sub Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False principal.TextBox2 = "" With Worksheets("hoja3").Range("e3:f20000") Set c = .Find(TextBox1.Value, LookIn:=xlValues) If Not c Is Nothing Then principal.TextBox2.Value = c.Offset(0, 1) Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End If End With End Sub Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False principal.TextBox4 = "" With Worksheets("hoja3").Range("i1:j10") Set c = .Find(TextBox3.Value, LookIn:=xlValues) If Not c Is Nothing Then principal.TextBox4.Value = c.Offset(0, 1) Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End If End With End Sub Private Sub UserForm_Activate() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Label17.Visible = False ACEPTAR.Visible = False CommandButton1.Visible = True Sheets("Hoja3").Visible = xlSheetVisible Sheets("Hoja3").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Range("F2").Select registro = ActiveCell.FormulaR1C1 Sheets("Hoja3").Visible = xlSheetVeryHidden Sheets("Hoja2").Visible = xlSheetVisible Sheets("Hoja2").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Range("A1").Select ActiveCell.Offset(registro, 1).Select fecha = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select codigo = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select nombre = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select maquina = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select problema = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select comentario = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select repuestos = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select horometro = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select templeado = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select numeroot = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, 1).Select generarot = ActiveCell.FormulaR1C1 ActiveCell.Offset(0, -11).Select Sheets("Hoja2").Visible = xlSheetVisible nuevo.Enabled = True salvar.Enabled = False comentario.Locked = True repuestos.Locked = True horometro.Locked = True templeado.Locked = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub

Bienvenido a la mayor comunidad de usuarios EXCEL

Regístrate gratis ahora para ver contenidos y descargas sin restricciones!

Regístrate gratis Ingresar

JavaScript está desactivado. Para una mejor experiencia, por favor active JavaScript en su navegador antes de continuar.

Ayuda para mejorar este codigo

Autor del tema cndrorbes
Fecha de inicio 31 Mar 2014

cndrorbes

New member

31 Mar 2014

Hola amigo, alguien me puede ayudar a mejorar este codigo, el problema es que esta lenta la aplicación.

saludos,

Private Sub ACEPTAR_Click()
Label17.Visible = False
ACEPTAR.Visible = False
End...

Para poder visualizar el resto de este tema y sus adjuntos:
. Si nunca te has registrado puedes registrarte gratis aquí
. Si ya te has registrado debes iniciar sesión aquí

Iniciar sesión o registrarme para responder aquí.

Temas similares

Pregunta

Ayuda mejorar esta fórmula

Respuestas: 6

9 Ene 2015

canino19

Pregunta

ayuda para mejorar verificacion de num. primos

Respuestas: 18

9 Abr 2015

oknarf1976

Pregunta

Ayuda con tabla de control laboral

Respuestas: 6

29 Ago 2026

Julioma123

Resuelto

No funciona la pagina de Ayuda Excel de Microsoft??

Respuestas: 3

1 Jul 2026

Héctor Miguel

Pregunta

ayuda con este formula me marca error

Respuestas: 2

14 May 2026

Gerson Pineda

Resuelto

Ayuda con este ejercicio

Respuestas: 6

17 Abr 2026

FGV

Pregunta

ayuda con formula

Respuestas: 2

24 Mar 2026

Julioma123

Resuelto

Ayuda para crear una clasificacion

Respuestas: 10

20 Feb 2026

berruga

Resuelto

Ayuda a buscar en listado de productos

Respuestas: 6

17 Feb 2026

katto

Resuelto

Ayuda con formula de varios criterios

Respuestas: 5

17 Feb 2026

jarja33

Facebook X Bluesky LinkedIn Reddit Pinterest Tumblr WhatsApp Correo electrónico Enlace

Bienvenido a nuestro foro Excel 👋

Tenemos 135.000 usuarios registrados,
y 240.000 preguntas y respuestas Excel.

Primero 👉 regístrate gratis aquí 👈
para ver contenidos y descargas
sin restricciones!

Este sitio usa cookies para ayudar a personalizar el contenido, adaptar su experiencia y mantenerlo conectado si se registra.
Al continuar usando este sitio, usted está consintiendo nuestro uso de cookies.

Aceptar Saber más…

Volver

Arriba