PERSONALIZACION A NIVEL DE DOCUMENTO EXCEL SE CONGELA

carlos espinosa 21 Reputation points
2022-10-28T00:26:51.693+00:00

Saludos cordiales

Soy nuevo en Visual Studio. Tengo un código alojado en un botón Ribbon, desde el cual, obtengo datos de una hoja de cálculo los proceso y obtengo unos resultados.
Presento además un formulario de avance de proceso mediante Do events durante el cálculo, solo que cuando se genera un error en medio proceso, lo capturo con el bloque Try Catch, cierro el formulario, y aplico exit sub, pero a pesar de esto el documento se congela y el ratón responde en toda la ribbon de excel pero nada en las celdas. El codigo involucrado es el siguiente:


Dim frm As New FrmVista

Private Sub Btn_Importar_Click(sender As Object, e As RibbonControlEventArgs) Handles Btn_Importar.Click

    Globals.ThisWorkbook.Application.ScreenUpdating = False  

    Try  

        Dim Shojas As Excel.Sheets = Globals.ThisWorkbook.Sheets  
        Dim Sdatos As Excel.Worksheet = Globals.ThisWorkbook.Sheets(5)  
        Dim jk As String = Sdatos.Name  
        Dim resultado As Excel.Range  
        Dim resultadom As Excel.Range  
        Dim resultadoe As Excel.Range  
        Dim resultadot As Excel.Range  
        Dim resultado2 As Excel.Range  
        Dim k As Integer  

        Dim fi As Integer = 6 'fila de inicio de MAT en MAT  
        Dim fr As Integer = 6 'fila de inicio de rubros EN RUBROS  
        Dim cm As Integer = 9 'columna inicial pegado materiales en hoja RUBROS  
        Dim fim As Integer = 5 'fila de inicio de mano de obra en MOB  
        Dim cmo As Integer = 49 'columna inicial pegado mano de obra en hoja RUBROS  
        Dim fie As Integer = 3 'fila de inicio de equipo en EQ  
        Dim cme As Integer = 89 'columna inicial pegado equipo en hoja RUBROS  
        Dim cmt As Integer = 7 'columna inicial pegado transporte en hoja MAT  
        Dim cmtr As Integer = 129 'columna inicial pegado transporte en hoja RUBROS  
        Dim Ctt1 As Boolean  

        Dim i As Integer  
        Dim im As Integer  
        Dim ie As Integer  

        If Shojas.Count = 6 Then  
            MsgBox("No ha ingresado ninguna hoja de APUS individuales para importar, el proceso se cancela", MsgBoxStyle.Exclamation, "Nueva importación")  
            Globals.ThisWorkbook.Application.ScreenUpdating = True  
            Exit Sub  
        End If  
        'Dim frm As New FrmVista  
        frm.Show()  

        'Direcciones generales  
        Dim I1 As Integer = Sdatos.Range("D7").Value ' Ubicación Columna donde esta la fila de inicio de recursos en tabla auxiliar por cada apu  
        Dim I2 As Integer = Sdatos.Range("D8").Value ' Ubicación Columna donde esta la fila de fin de recursos en tabla auxiliar por cada apu  
        Dim Nr = Sdatos.Range("D11").Value ' Ubicación columna nombres de recursos  
        Dim TxHerr = Left(Sdatos.Range("I7").Value, 11) ' Texto de Herramientas manuales  
        Dim Rapu As String = Sdatos.Range("K9").Value ' Direccion de la ubicacion de rendimiento del apu  
        Dim Napu As String = Sdatos.Range("K10").Value ' Direccion de la ubicacion de Nombre de rubro del apu  
        Dim Uapu As String = Sdatos.Range("K11").Value ' Direccion de la ubicacion de Unidad del apu  
        Dim Capu As String = Sdatos.Range("K12").Value ' Direccion de la ubicacion de Codigo del apu  
        'Direcciones de materiales************************  
        Dim Cum = Sdatos.Range("D14").Value ' Ubicación columna unidad de material  
        Dim Cpm = Sdatos.Range("D15").Value ' Ubicación columna precio unitario de material  
        Dim CCm = Sdatos.Range("D16").Value ' Ubicación columna cantidad de material  
        Dim CVm = Sdatos.Range("I14").Value ' Ubicación columna VAE de material  
        Dim Ccpcm = Sdatos.Range("I15").Value ' Ubicación columna CPC de material  
        'Direcciones de mano de obra  
        Dim Cjmo = Sdatos.Range("D18").Value ' Ubicación columna jornal mano de obra  
        Dim Ccmo = Sdatos.Range("D19").Value ' Ubicación columna cantidad de mano de obra  
        Dim CVmo = Sdatos.Range("I18").Value ' Ubicación columna VAE de mano de obra  
        Dim Ccpcmo = Sdatos.Range("I19").Value ' Ubicación columna CPC de mano de obra  
        'Direcciones de equipo  
        Dim Cteq = Sdatos.Range("D21").Value ' Ubicación columna Tarifa de equipo  
        Dim Cceq = Sdatos.Range("D22").Value ' Ubicación columna cantidad de equipo  
        Dim CVeq = Sdatos.Range("I21").Value ' Ubicación columna VAE de equipo  
        Dim Ccpceq = Sdatos.Range("I22").Value ' Ubicación columna CPC de equipo  
        'Direcciones de transporte************************  
        Dim Cut = Sdatos.Range("D24").Value ' Ubicación columna unidad de transporte  
        Dim Ctt = Sdatos.Range("D25").Value ' Ubicación columna precio unitario de transporte  
        Dim Cct = Sdatos.Range("D26").Value ' Ubicación columna cantidad de transporte  
        Dim Cvt = Sdatos.Range("I24").Value ' Ubicación columna VAE de transporte  
        Dim Ccpct = Sdatos.Range("I25").Value ' Ubicación columna CPC de transporte  

        For k = 7 To Shojas.Count 'corre de 1 al numero de APUS detectados en la base  
            System.Windows.Forms.Application.DoEvents()  
            frm.Label1.Text = "Procesando rubro  ==> " & k & " de:==> " & Shojas.Count  
            Dim kl As Excel.Worksheet = Shojas.Item(k) 'kl representa a cada una de las hojas de APUS ingresadas por el usuario  
            Dim fima1 As Excel.Range = kl.Cells(1, I1)  
            Dim fima As Integer = fima1.Value2 'FILA de INICIO de MATERIALES  
            Dim fimo1 As Excel.Range = kl.Cells(2, I1)  
            Dim fimo As Integer = fimo1.Value2 'FILA de INICIO de MANO DE OBRA  
            Dim fieq1 As Excel.Range = kl.Cells(3, I1)  
            Dim fieq As Integer = fieq1.Value2 'FILA de INICIO de EQUIPOS  
            Dim ffma1 As Excel.Range = kl.Cells(1, I2)  
            Dim ffma As Integer = ffma1.Value2  
            Dim ffmo1 As Excel.Range = kl.Cells(2, I2)  
            Dim ffmo As Integer = ffmo1.Value2  
            Dim ffeq1 As Excel.Range = kl.Cells(3, I2)  
            Dim ffeq As Integer = ffeq1.Value2  
            Dim fitr1 As Excel.Range = kl.Cells(4, I1)  
            Dim fitr As Integer = fitr1.Value2  
            Dim fftr1 As Excel.Range = kl.Cells(4, I2)  
            Dim fftr As Integer = fftr1.Value2  

            'M A T E R  I A L E S  *****************************************************************************************  
            'Extraemos los MATERIALES de la hoja y almacenamos en la base de materiales y en la base de rubros  
            Dim f0mat As Integer = fima  
            Dim rangomat As Integer = ffma - fima  

            For i = 1 To rangomat + 1 'corre de 1 al numero de materiales detectados en el precio unitario  

                Dim mat1 As String = CType(kl.Cells(f0mat, Nr), Excel.Range).Value2 'OJO Ingresamos en mat1 el material actual OJO 1 quiere decir que a partir de la 1ra columna estan las descripciones de materiales  
                Dim mat2 As String = Left(mat1, 255)  

                Select Case mat1  
                    Case ""  
                        If rangomat = 0 Then Exit For  
                        f0mat = f0mat + 1 'aumentamos contador de filas de APUCOPIA  
                    Case 0  
                        If rangomat = 0 Then Exit For  
                        f0mat = f0mat + 1 'aumentamos contador de filas de APUCOPIA  
                    Case Is <> ""  

                        Globals.Hoja2.Activate()  
                        'buscamos el material en la base actual MAT, si aparece no lo adicionamos sino lo adicionamos a la base MAT  
                        resultado = Globals.Hoja2.Range("bus").Find(mat2, , Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlWhole, Excel.XlSearchOrder.xlByColumns, Excel.XlSearchDirection.xlNext, False, , False)  

                        If resultado Is Nothing Then  
                            'Almacenamos en la base de MAT  
                            Globals.Hoja2.Cells(fi, 2) = Trim(CType(kl.Cells(f0mat, Nr), Excel.Range).Value2) 'OJO almacena nombre  
                            Globals.Hoja2.Cells(fi, 3) = kl.Cells(f0mat, Cum) 'OJO almacena unidad  
                            Globals.Hoja2.Cells(fi, 4) = kl.Cells(f0mat, Cpm) 'OJO almacena precio  
                            If Globals.Ribbons.Ribbon1.Chb_V.Checked = True Then  
                                Globals.Hoja2.Cells(fi, 5) = kl.Cells(f0mat, CVm) 'OJO almacena VAE  
                                Globals.Hoja2.Cells(fi, 9) = kl.Cells(f0mat, Ccpcm) 'OJO almacena CPC  
                            End If  


                            Globals.Hoja1.Cells(fr, cm) = Globals.Hoja2.Cells(fi, 1) ' almacena codigo rubro en hoja RUBROS  
                            Globals.Hoja1.Cells(fr, cm + 1) = kl.Cells(f0mat, CCm) 'OJO almacena cantidad  

                            f0mat = f0mat + 1 'aumentamos contador de filas de APUCOPIA  
                            fi = fi + 1 'aumentamos fila de la hoja MAT  
                            cm = cm + 2 'aumentamos columna de hoja rubros  


                        Else  
                            'no almacenamos este material en la base MAT y añadimos su codigo y cant en base RUBROS  
                            Dim RR As Integer = resultado.Row  
                            Dim OpCtt As String = CType(Globals.Hoja2.Cells(RR, 4), Excel.Range).Value2  
                            If OpCtt <> "" Then  
                                Ctt1 = True  
                            Else  
                                Ctt1 = False 'Si el material encontrado tiene precio es material, caso contrario es transporte  
                            End If  

                            If Ctt1 = True Then ' Si el material(transporte) encontrado tiene precio de material agregamos su codigo y cantidad a la base rubros  

                                Globals.Hoja1.Cells(fr, cm) = Globals.Hoja2.Cells(RR, 1) ' almacena codigo rubro en hoja RUBROS  
                                Globals.Hoja1.Cells(fr, cm + 1) = kl.Cells(f0mat, CCm) 'OJO almacena cantidad  
                                f0mat = f0mat + 1 'aumentamos contador de filas de APUCOPIA  
                                cm = cm + 2 'aumentamos columna de hoja rubros  
                            Else ' Si el material(Transporte) encontrado no tiene precio de material entonces es transporte y agregamos el precio de material  
                                Globals.Hoja1.Cells(fr, cm) = Globals.Hoja2.Cells(RR, 1) ' almacena codigo rubro en hoja RUBROS  
                                Globals.Hoja1.Cells(fr, cm + 1) = kl.Cells(f0mat, CCm) 'OJO almacena cantidad  
                                Globals.Hoja2.Cells(RR, 4) = kl.Cells(f0mat, Cpm) 'almacena precio de material  
                                f0mat = f0mat + 1 'aumentamos contador de filas de APUCOPIA  
                                cm = cm + 2 'aumentamos columna de hoja rubros  
                            End If  
                        End If  

                End Select  

            Next i  

                         'Finalmente enviamos datos de encabezado del APU  
            Globals.Hoja1.Cells(fr, 8) = kl.Range(Rapu) 'pega rendimiento  
            Globals.Hoja1.Cells(fr, 5) = kl.Range(Napu) 'OJO pega nombre de rubro  
            Globals.Hoja1.Cells(fr, 7) = kl.Range(Uapu) 'OJO pega unidad  
            Globals.Hoja1.Cells(fr, 2) = kl.Range(Capu) 'OJO pega codigo de rubro  

            fr = fr + 1  
            cm = 9 'columna inicial pegado materiales en hoja RUBROS  
            cmo = 49 'columna inicial pegado mano de obra en hoja RUBROS  
            cme = 89 'columna inicial pegado equipo en hoja RUBROS  
            cmtr = 129 'columna inicial pegado transporte en hoja RUBROS  

        Next k 'Llamamos al siguiente rubro para su procesamiento  

        frm.Hide()  
        MsgBox("Proceso de importación terminado con éxito. Proceda a llevar los datos importados a su versión de APU-EXCEL", MsgBoxStyle.OkOnly, "Importación concluida")  

        Globals.Hoja1.Activate()  
        Globals.ThisWorkbook.Application.ScreenUpdating = True  

    Catch Ex As Exception  
        MsgBox("Se ha producido el siguiente error, se interrumpe la ejecución :==> " & Ex.Message, MsgBoxStyle.Critical)  
        frm.Close()  
        Exit Sub  


    End Try  

End Sub  

Mil gracias de antemano por su invaluable ayuda

Community Center | Not monitored
0 comments No comments
{count} votes

Accepted answer
  1. Anonymous
    2022-10-28T00:52:50.263+00:00

    Q&A forums are currently English only. I'd try asking for help over here in dedicated forums.
    https://social.msdn.microsoft.com/Forums/es-es/home
    https://social.technet.microsoft.com/Forums/es-es/home
    https://answers.microsoft.com/es-es

    --please don't forget to upvote and Accept as answer if the reply is helpful--


0 additional answers

Sort by: Most helpful

Your answer

Answers can be marked as Accepted Answers by the question author, which helps users to know the answer solved the author's problem.