Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
user form infinit loop
hi,
I am designing a Data base. for feeling it out, I am designing a Userform. my userform, have a Combobox that by been selected, feels in couple txtboxes with data from the worksheet. when I am done, editing the textboxes, I have the button Edit, that will paste the new values on the worksheet. My problem is, when I edit, the combobox_change code runs and i get myself into a infinit loop. is therea way to tel the code not to go there on change? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
user form infinit loop
Turn of events at beginning to code and turn them back on at the end
Application.EnableEvents = False Application.EnableEvents = True "Paulo" wrote: hi, I am designing a Data base. for feeling it out, I am designing a Userform. my userform, have a Combobox that by been selected, feels in couple txtboxes with data from the worksheet. when I am done, editing the textboxes, I have the button Edit, that will paste the new values on the worksheet. My problem is, when I edit, the combobox_change code runs and i get myself into a infinit loop. is therea way to tel the code not to go there on change? |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
user form infinit loop
didnt work,
Private Sub CmdEditar_Click() Application.EnableEvents = False ... code... Range("c" & seriaL).Value = ndtcontratO (here is when the programs calls CmbEmpresa_Change) and output's Infinit loop ... code... Unload Me Application.EnableEvents = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub "Joel" wrote: Turn of events at beginning to code and turn them back on at the end Application.EnableEvents = False Application.EnableEvents = True "Paulo" wrote: hi, I am designing a Data base. for feeling it out, I am designing a Userform. my userform, have a Combobox that by been selected, feels in couple txtboxes with data from the worksheet. when I am done, editing the textboxes, I have the button Edit, that will paste the new values on the worksheet. My problem is, when I edit, the combobox_change code runs and i get myself into a infinit loop. is therea way to tel the code not to go there on change? |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
user form infinit loop
I think you need to step through the code to determine what is happening.
click on the line Range("c" & seriaL).Value = ndtcontratO then Press F9 to set a break point. Start the code the way you would normally do and the macro should stop on the line with the break point. Then type F8 to step through code. You can add more break points and use F5 to run until next break or until the end. I can't see from the code provided what is causing the inifinite loop. "Paulo" wrote: didnt work, Private Sub CmdEditar_Click() Application.EnableEvents = False ... code... Range("c" & seriaL).Value = ndtcontratO (here is when the programs calls CmbEmpresa_Change) and output's Infinit loop ... code... Unload Me Application.EnableEvents = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub "Joel" wrote: Turn of events at beginning to code and turn them back on at the end Application.EnableEvents = False Application.EnableEvents = True "Paulo" wrote: hi, I am designing a Data base. for feeling it out, I am designing a Userform. my userform, have a Combobox that by been selected, feels in couple txtboxes with data from the worksheet. when I am done, editing the textboxes, I have the button Edit, that will paste the new values on the worksheet. My problem is, when I edit, the combobox_change code runs and i get myself into a infinit loop. is therea way to tel the code not to go there on change? |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
user form infinit loop
I have posted the .xls file he
http://rapidshare.com/files/15902498...M_0.2.xls.html try sheet "Menu"Editar dadoscombobox "Paulo" insert some text on OBS (dont forget to check the box) Editar thanks for helping out Paul. "Joel" wrote: I think you need to step through the code to determine what is happening. click on the line Range("c" & seriaL).Value = ndtcontratO then Press F9 to set a break point. Start the code the way you would normally do and the macro should stop on the line with the break point. Then type F8 to step through code. You can add more break points and use F5 to run until next break or until the end. I can't see from the code provided what is causing the inifinite loop. "Paulo" wrote: didnt work, Private Sub CmdEditar_Click() Application.EnableEvents = False ... code... Range("c" & seriaL).Value = ndtcontratO (here is when the programs calls CmbEmpresa_Change) and output's Infinit loop ... code... Unload Me Application.EnableEvents = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub "Joel" wrote: Turn of events at beginning to code and turn them back on at the end Application.EnableEvents = False Application.EnableEvents = True "Paulo" wrote: hi, I am designing a Data base. for feeling it out, I am designing a Userform. my userform, have a Combobox that by been selected, feels in couple txtboxes with data from the worksheet. when I am done, editing the textboxes, I have the button Edit, that will paste the new values on the worksheet. My problem is, when I edit, the combobox_change code runs and i get myself into a infinit loop. is therea way to tel the code not to go there on change? |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
user form infinit loop
I used the View - Call Stack to find where the problem was. I looked like
changing the selection of the worksheet was causing a false change of you userform. I suspect that the userform and the worksheet visible at the same time created the problem. In the code below I eliminated any SELECTs in the code. This seemed to solve the problem. Option Explicit Dim linhA As Long Dim colunA As Long Private Sub cbxAgente_Click() If cbxAgente = False Then TxtAgente.Enabled = False If cbxAgente = True Then TxtAgente.Enabled = True End Sub Private Sub cbxComissao_Click() If cbxComissao = False Then TxtComissao.Enabled = False If cbxComissao = True Then TxtComissao.Enabled = True End Sub Private Sub cbxDtContrato_Click() If cbxDtContrato = False Then TxtDtContrato.Enabled = False If cbxDtContrato = True Then TxtDtContrato.Enabled = True End Sub Private Sub cbxFator_Click() If cbxFator = False Then TxtFator.Enabled = False If cbxFator = True Then TxtFator.Enabled = True End Sub Private Sub cbxFomFix_Click() If cbxFomFix = False Then TxtFomFix.Enabled = False If cbxFomFix = True Then TxtFomFix.Enabled = True End Sub Private Sub cbxFomVar_Click() If cbxFomVar = False Then TxtFomVar.Enabled = False If cbxFomVar = True Then TxtFomVar.Enabled = True End Sub Private Sub cbxMora_Click() If cbxMora = False Then TxtMora.Enabled = False If cbxMora = True Then TxtMora.Enabled = True End Sub Private Sub cbxObs_Click() If cbxObs = False Then TxtObs.Enabled = False If cbxObs = True Then TxtObs.Enabled = True End Sub Private Sub cbxTaxa_Click() If cbxTaxa = False Then TxtTaxa.Enabled = False If cbxTaxa = True Then TxtTaxa.Enabled = True End Sub Private Sub CmbEmpresa_Change() 'On Error GoTo trataErro Application.ScreenUpdating = False ' CmbEmpresa.RowSource = clientes: Column (1) 'Atual TxtDtContrato.Enabled = False TxtDtContrato = Format(CmbEmpresa.Column(2), "dd/mm/yyyy") TxtAgente.Enabled = False TxtAgente = CmbEmpresa.Column(3) TxtComissao.Enabled = False TxtComissao = CmbEmpresa.Column(4) TxtTaxa.Enabled = False TxtTaxa = CmbEmpresa.Column(5) TxtFator.Enabled = False TxtFator = CmbEmpresa.Column(6) TxtMora.Enabled = False TxtMora = CmbEmpresa.Column(7) TxtFomFix.Enabled = False TxtFomFix = CmbEmpresa.Column(8) TxtFomVar.Enabled = False TxtFomVar = CmbEmpresa.Column(9) TxtObs.Enabled = False TxtObs = CmbEmpresa.Column(10) 'Anterior Dim empresA As String Dim empLastnum As Long Dim empCounter As Long Dim empvalue As String Dim seriaL As Long Dim linEmp empresA = CmbEmpresa.Column(1) With Sheets("audit") seriaL = 1 + .Range("A65000").End(xlUp).Value Do Until seriaL = 1 empvalue = .Range("B" & seriaL).Value linEmp = .Range("B" & seriaL).Row If empvalue = empresA Then LblDtcontratoV = .Range("D" & linEmp).Value LblAgenteV = .Range("F" & linEmp).Value LblComissaoV = .Range("H" & linEmp).Value LblTaxaV = .Range("J" & linEmp).Value LblFatorV = .Range("L" & linEmp).Value LblMoraV = .Range("N" & linEmp).Value LblFomFixV = .Range("P" & linEmp).Value LblFomVarV = .Range("R" & linEmp).Value LblObsV = .Range("T" & linEmp).Value Exit Do End If seriaL = seriaL - 1 Loop End With If empvalue < empresA Then LblDtcontratoV = " - " LblAgenteV = " - " LblComissaoV = " - " LblTaxaV = " - " LblFatorV = " - " LblMoraV = " - " LblFomFixV = " - " LblFomVarV = " - " LblObsV = " - " 'MsgBox "Auditoria anterior para esta empresa não encontrada." End If 'Percentil If IsDate(LblDtcontratoV) = True And IsDate(TxtDtContrato) = True Then _ LblDtcontratoP = DateValue(TxtDtContrato) - DateValue(LblDtcontratoV) If IsNumeric(LblAgenteV) = True And IsNumeric(TxtAgente) Then _ LblAgenteP = (LblAgenteV / TxtAgente) * 100 If IsNumeric(LblComissaoV) = True And IsNumeric(TxtComissao) Then _ LblComissaoP = (LblComissaoV / TxtComissao) * 100 If IsNumeric(LblTaxaV) = True And IsNumeric(TxtTaxa) Then _ LblTaxaP = (LblTaxaV / TxtTaxa) * 100 If IsNumeric(LblFatorV) = True And IsNumeric(TxtFator) Then _ LblFatorP = (LblFatorV / TxtFator) * 100 If IsNumeric(LblMoraV) = True And IsNumeric(TxtMora) Then _ LblMoraP = (LblMoraV / TxtMora) * 100 If IsNumeric(LblFomFixV) = True And IsNumeric(TxtFomFix) Then _ LblFomFixP = (LblFomFixV / TxtFomFix) * 100 If IsNumeric(LblFomVarV) = True And IsNumeric(TxtFomVar) Then _ LblFomVarP = (LblFomVarV / TxtFomVar) * 100 Application.ScreenUpdating = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub Private Sub CmdCancel_Click() Unload Me End Sub Private Sub CmdEditar_Click() Application.EnableEvents = False 'On Error GoTo trataErro Dim seriaL As Long Dim emponchnG As String Dim empresA As String Dim dtcontratO As Date Dim ndtcontratO As Date Dim agentE As Long Dim nagentE As Long Dim comissaO As Double Dim ncomissaO As Double Dim taxA As Double Dim ntaxA As Double Dim fatoR As Double Dim nfatoR As Double Dim morA As Double Dim nmorA As Double Dim fomfixO As Double Dim nfomfixO As Double Dim fomvaR As Double Dim nfomvaR As Double Dim obS As String Dim nobS As String Dim LastCell As Range 'coleta empresA = CmbEmpresa.Column(1) dtcontratO = Format(CmbEmpresa.Column(2), "dd/mm/yyyy") agentE = CmbEmpresa.Column(3) comissaO = CmbEmpresa.Column(4) taxA = CmbEmpresa.Column(5) fatoR = CmbEmpresa.Column(6) morA = CmbEmpresa.Column(7) fomfixO = CmbEmpresa.Column(8) fomvaR = CmbEmpresa.Column(9) obS = CmbEmpresa.Column(10) ndtcontratO = TxtDtContrato.Value nagentE = TxtAgente.Value ncomissaO = TxtComissao.Value ntaxA = TxtTaxa.Value nfatoR = TxtFator.Value nmorA = TxtMora.Value nfomfixO = TxtFomFix.Value nfomvaR = TxtFomVar.Value nobS = TxtObs.Value 'DB 'Application.ScreenUpdating = False Application.EnableCancelKey = xlDisabled 'Sheets("BD").Unprotect = "" With Sheets("BD") .Visible = True seriaL = .Range("A65000").End(xlUp).Value + 1 Do Until seriaL = 1 emponchnG = .Range("B" & seriaL).Value If emponchnG = empresA Then Application.EnableEvents = False .Range("c" & seriaL).Value = ndtcontratO .Range("d" & seriaL).Value = nagentE .Range("e" & seriaL).Value = ncomissaO .Range("f" & seriaL).Value = ntaxA .Range("g" & seriaL).Value = nfatoR .Range("h" & seriaL).Value = nmorA .Range("i" & seriaL).Value = nfomfixO .Range("j" & seriaL).Value = nfomvaR .Range("k" & seriaL).Value = nobS .Range("l" & seriaL).Value = Format(Right(ndtcontratO, 2), "000") 'Sheets("BD").Protect = "" 'Sheets("BD").Visible = False End If seriaL = seriaL - 1 Loop End With 'AUDIT 'Application.ScreenUpdating = False Application.EnableCancelKey = xlDisabled 'Sheets("BD").Unprotect = "" Sheets("AUDIT").Visible = True With Sheets("AUDIT") seriaL = .Range("a65000").End(xlUp).Value If IsNumeric(seriaL) = False Then seriaL = 1 Set LastCell = .Range("a" & Rows.Count).End(xlUp) With LastCell .Offset(1, 0).EntireRow.Insert .Offset(1, 0) = seriaL + 1 .Offset(1, 1) = empresA .Offset(1, 2) = Date .Offset(1, 3) = dtcontratO .Offset(1, 4) = ndtcontratO .Offset(1, 5) = agentE .Offset(1, 6) = nagentE .Offset(1, 7) = comissaO .Offset(1, 8) = ncomissaO .Offset(1, 9) = taxA .Offset(1, 10) = ntaxA .Offset(1, 11) = fatoR .Offset(1, 12) = nfatoR .Offset(1, 13) = morA .Offset(1, 14) = nmorA .Offset(1, 15) = fomfixO .Offset(1, 16) = nfomfixO .Offset(1, 17) = fomvaR .Offset(1, 18) = nfomvaR .Offset(1, 19) = obS .Offset(1, 20) = nobS End With End With Unload Me Application.EnableEvents = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub Private Sub TxtAgente_Change() If TxtAgente < "" Then If IsNumeric(LblAgenteV) = True And IsNumeric(TxtAgente) Then _ LblAgenteP = (LblAgenteV / TxtAgente) * 100 End Sub Private Sub TxtComissao_Change() If TxtComissao < "" Then If IsNumeric(LblComissaoV) = True And IsNumeric(TxtComissao) Then _ LblComissaoP = (LblComissaoV / TxtComissao) * 100 End Sub Private Sub TxtDtContrato_Change() If TxtDtContrato < "" Then If IsDate(LblDtcontratoV) = True And IsDate(TxtDtContrato) = True Then _ LblDtcontratoP = DateValue(TxtDtContrato) - DateValue(LblDtcontratoV) End Sub Private Sub TxtFator_Change() If TxtFator < "" Then If IsNumeric(LblFatorV) = True And IsNumeric(TxtFator) Then _ LblFatorP = (LblFatorV / TxtFator) * 100 End Sub Private Sub TxtFomFix_Change() If TxtFomFix < "" Then If IsNumeric(LblFomFixV) = True And IsNumeric(TxtFomFix) Then _ LblFomFixP = (LblFomFixV / TxtFomFix) * 100 End Sub Private Sub TxtFomVar_Change() If TxtFomVar < "" Then If IsNumeric(LblFomVarV) = True And IsNumeric(TxtFomVar) Then _ LblFomVarP = (LblFomVarV / TxtFomVar) * 100 End Sub Private Sub TxtMora_Change() If TxtMora < "" Then If IsNumeric(LblMoraV) = True And IsNumeric(TxtMora) Then _ LblMoraP = (LblMoraV / TxtMora) * 100 End Sub Private Sub TxtTaxa_Change() If TxtTaxa < "" Then If IsNumeric(LblTaxaV) = True And IsNumeric(TxtTaxa) Then _ LblTaxaP = (LblTaxaV / TxtTaxa) End Sub "Paulo" wrote: I have posted the .xls file he http://rapidshare.com/files/15902498...M_0.2.xls.html try sheet "Menu"Editar dadoscombobox "Paulo" insert some text on OBS (dont forget to check the box) Editar thanks for helping out Paul. "Joel" wrote: I think you need to step through the code to determine what is happening. click on the line Range("c" & seriaL).Value = ndtcontratO then Press F9 to set a break point. Start the code the way you would normally do and the macro should stop on the line with the break point. Then type F8 to step through code. You can add more break points and use F5 to run until next break or until the end. I can't see from the code provided what is causing the inifinite loop. "Paulo" wrote: didnt work, Private Sub CmdEditar_Click() Application.EnableEvents = False ... code... Range("c" & seriaL).Value = ndtcontratO (here is when the programs calls CmbEmpresa_Change) and output's Infinit loop ... code... Unload Me Application.EnableEvents = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub "Joel" wrote: Turn of events at beginning to code and turn them back on at the end Application.EnableEvents = False Application.EnableEvents = True "Paulo" wrote: hi, I am designing a Data base. for feeling it out, I am designing a Userform. my userform, have a Combobox that by been selected, feels in couple txtboxes with data from the worksheet. when I am done, editing the textboxes, I have the button Edit, that will paste the new values on the worksheet. My problem is, when I edit, the combobox_change code runs and i get myself into a infinit loop. is therea way to tel the code not to go there on change? |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
user form infinit loop
yES, iT Did solve the loop. thank you.
I have to read a couple more time to see what you have done. thank you very much "Joel" wrote: I used the View - Call Stack to find where the problem was. I looked like changing the selection of the worksheet was causing a false change of you userform. I suspect that the userform and the worksheet visible at the same time created the problem. In the code below I eliminated any SELECTs in the code. This seemed to solve the problem. Option Explicit Dim linhA As Long Dim colunA As Long Private Sub cbxAgente_Click() If cbxAgente = False Then TxtAgente.Enabled = False If cbxAgente = True Then TxtAgente.Enabled = True End Sub Private Sub cbxComissao_Click() If cbxComissao = False Then TxtComissao.Enabled = False If cbxComissao = True Then TxtComissao.Enabled = True End Sub Private Sub cbxDtContrato_Click() If cbxDtContrato = False Then TxtDtContrato.Enabled = False If cbxDtContrato = True Then TxtDtContrato.Enabled = True End Sub Private Sub cbxFator_Click() If cbxFator = False Then TxtFator.Enabled = False If cbxFator = True Then TxtFator.Enabled = True End Sub Private Sub cbxFomFix_Click() If cbxFomFix = False Then TxtFomFix.Enabled = False If cbxFomFix = True Then TxtFomFix.Enabled = True End Sub Private Sub cbxFomVar_Click() If cbxFomVar = False Then TxtFomVar.Enabled = False If cbxFomVar = True Then TxtFomVar.Enabled = True End Sub Private Sub cbxMora_Click() If cbxMora = False Then TxtMora.Enabled = False If cbxMora = True Then TxtMora.Enabled = True End Sub Private Sub cbxObs_Click() If cbxObs = False Then TxtObs.Enabled = False If cbxObs = True Then TxtObs.Enabled = True End Sub Private Sub cbxTaxa_Click() If cbxTaxa = False Then TxtTaxa.Enabled = False If cbxTaxa = True Then TxtTaxa.Enabled = True End Sub Private Sub CmbEmpresa_Change() 'On Error GoTo trataErro Application.ScreenUpdating = False ' CmbEmpresa.RowSource = clientes: Column (1) 'Atual TxtDtContrato.Enabled = False TxtDtContrato = Format(CmbEmpresa.Column(2), "dd/mm/yyyy") TxtAgente.Enabled = False TxtAgente = CmbEmpresa.Column(3) TxtComissao.Enabled = False TxtComissao = CmbEmpresa.Column(4) TxtTaxa.Enabled = False TxtTaxa = CmbEmpresa.Column(5) TxtFator.Enabled = False TxtFator = CmbEmpresa.Column(6) TxtMora.Enabled = False TxtMora = CmbEmpresa.Column(7) TxtFomFix.Enabled = False TxtFomFix = CmbEmpresa.Column(8) TxtFomVar.Enabled = False TxtFomVar = CmbEmpresa.Column(9) TxtObs.Enabled = False TxtObs = CmbEmpresa.Column(10) 'Anterior Dim empresA As String Dim empLastnum As Long Dim empCounter As Long Dim empvalue As String Dim seriaL As Long Dim linEmp empresA = CmbEmpresa.Column(1) With Sheets("audit") seriaL = 1 + .Range("A65000").End(xlUp).Value Do Until seriaL = 1 empvalue = .Range("B" & seriaL).Value linEmp = .Range("B" & seriaL).Row If empvalue = empresA Then LblDtcontratoV = .Range("D" & linEmp).Value LblAgenteV = .Range("F" & linEmp).Value LblComissaoV = .Range("H" & linEmp).Value LblTaxaV = .Range("J" & linEmp).Value LblFatorV = .Range("L" & linEmp).Value LblMoraV = .Range("N" & linEmp).Value LblFomFixV = .Range("P" & linEmp).Value LblFomVarV = .Range("R" & linEmp).Value LblObsV = .Range("T" & linEmp).Value Exit Do End If seriaL = seriaL - 1 Loop End With If empvalue < empresA Then LblDtcontratoV = " - " LblAgenteV = " - " LblComissaoV = " - " LblTaxaV = " - " LblFatorV = " - " LblMoraV = " - " LblFomFixV = " - " LblFomVarV = " - " LblObsV = " - " 'MsgBox "Auditoria anterior para esta empresa não encontrada." End If 'Percentil If IsDate(LblDtcontratoV) = True And IsDate(TxtDtContrato) = True Then _ LblDtcontratoP = DateValue(TxtDtContrato) - DateValue(LblDtcontratoV) If IsNumeric(LblAgenteV) = True And IsNumeric(TxtAgente) Then _ LblAgenteP = (LblAgenteV / TxtAgente) * 100 If IsNumeric(LblComissaoV) = True And IsNumeric(TxtComissao) Then _ LblComissaoP = (LblComissaoV / TxtComissao) * 100 If IsNumeric(LblTaxaV) = True And IsNumeric(TxtTaxa) Then _ LblTaxaP = (LblTaxaV / TxtTaxa) * 100 If IsNumeric(LblFatorV) = True And IsNumeric(TxtFator) Then _ LblFatorP = (LblFatorV / TxtFator) * 100 If IsNumeric(LblMoraV) = True And IsNumeric(TxtMora) Then _ LblMoraP = (LblMoraV / TxtMora) * 100 If IsNumeric(LblFomFixV) = True And IsNumeric(TxtFomFix) Then _ LblFomFixP = (LblFomFixV / TxtFomFix) * 100 If IsNumeric(LblFomVarV) = True And IsNumeric(TxtFomVar) Then _ LblFomVarP = (LblFomVarV / TxtFomVar) * 100 Application.ScreenUpdating = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub Private Sub CmdCancel_Click() Unload Me End Sub Private Sub CmdEditar_Click() Application.EnableEvents = False 'On Error GoTo trataErro Dim seriaL As Long Dim emponchnG As String Dim empresA As String Dim dtcontratO As Date Dim ndtcontratO As Date Dim agentE As Long Dim nagentE As Long Dim comissaO As Double Dim ncomissaO As Double Dim taxA As Double Dim ntaxA As Double Dim fatoR As Double Dim nfatoR As Double Dim morA As Double Dim nmorA As Double Dim fomfixO As Double Dim nfomfixO As Double Dim fomvaR As Double Dim nfomvaR As Double Dim obS As String Dim nobS As String Dim LastCell As Range 'coleta empresA = CmbEmpresa.Column(1) dtcontratO = Format(CmbEmpresa.Column(2), "dd/mm/yyyy") agentE = CmbEmpresa.Column(3) comissaO = CmbEmpresa.Column(4) taxA = CmbEmpresa.Column(5) fatoR = CmbEmpresa.Column(6) morA = CmbEmpresa.Column(7) fomfixO = CmbEmpresa.Column(8) fomvaR = CmbEmpresa.Column(9) obS = CmbEmpresa.Column(10) ndtcontratO = TxtDtContrato.Value nagentE = TxtAgente.Value ncomissaO = TxtComissao.Value ntaxA = TxtTaxa.Value nfatoR = TxtFator.Value nmorA = TxtMora.Value nfomfixO = TxtFomFix.Value nfomvaR = TxtFomVar.Value nobS = TxtObs.Value 'DB 'Application.ScreenUpdating = False Application.EnableCancelKey = xlDisabled 'Sheets("BD").Unprotect = "" With Sheets("BD") .Visible = True seriaL = .Range("A65000").End(xlUp).Value + 1 Do Until seriaL = 1 emponchnG = .Range("B" & seriaL).Value If emponchnG = empresA Then Application.EnableEvents = False .Range("c" & seriaL).Value = ndtcontratO .Range("d" & seriaL).Value = nagentE .Range("e" & seriaL).Value = ncomissaO .Range("f" & seriaL).Value = ntaxA .Range("g" & seriaL).Value = nfatoR .Range("h" & seriaL).Value = nmorA .Range("i" & seriaL).Value = nfomfixO .Range("j" & seriaL).Value = nfomvaR .Range("k" & seriaL).Value = nobS .Range("l" & seriaL).Value = Format(Right(ndtcontratO, 2), "000") 'Sheets("BD").Protect = "" 'Sheets("BD").Visible = False End If seriaL = seriaL - 1 Loop End With 'AUDIT 'Application.ScreenUpdating = False Application.EnableCancelKey = xlDisabled 'Sheets("BD").Unprotect = "" Sheets("AUDIT").Visible = True With Sheets("AUDIT") seriaL = .Range("a65000").End(xlUp).Value If IsNumeric(seriaL) = False Then seriaL = 1 Set LastCell = .Range("a" & Rows.Count).End(xlUp) With LastCell .Offset(1, 0).EntireRow.Insert .Offset(1, 0) = seriaL + 1 .Offset(1, 1) = empresA .Offset(1, 2) = Date .Offset(1, 3) = dtcontratO .Offset(1, 4) = ndtcontratO .Offset(1, 5) = agentE .Offset(1, 6) = nagentE .Offset(1, 7) = comissaO .Offset(1, 8) = ncomissaO .Offset(1, 9) = taxA .Offset(1, 10) = ntaxA .Offset(1, 11) = fatoR .Offset(1, 12) = nfatoR .Offset(1, 13) = morA .Offset(1, 14) = nmorA .Offset(1, 15) = fomfixO .Offset(1, 16) = nfomfixO .Offset(1, 17) = fomvaR .Offset(1, 18) = nfomvaR .Offset(1, 19) = obS .Offset(1, 20) = nobS End With End With Unload Me Application.EnableEvents = True Exit Sub trataErro: MsgBox Error & " " & Err End Sub Private Sub TxtAgente_Change() If TxtAgente < "" Then If IsNumeric(LblAgenteV) = True And IsNumeric(TxtAgente) Then _ LblAgenteP = (LblAgenteV / TxtAgente) * 100 End Sub Private Sub TxtComissao_Change() If TxtComissao < "" Then If IsNumeric(LblComissaoV) = True And IsNumeric(TxtComissao) Then _ LblComissaoP = (LblComissaoV / TxtComissao) * 100 End Sub Private Sub TxtDtContrato_Change() If TxtDtContrato < "" Then If IsDate(LblDtcontratoV) = True And IsDate(TxtDtContrato) = True Then _ LblDtcontratoP = DateValue(TxtDtContrato) - DateValue(LblDtcontratoV) End Sub Private Sub TxtFator_Change() If TxtFator < "" Then If IsNumeric(LblFatorV) = True And IsNumeric(TxtFator) Then _ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Date field in user form & Loading a user form on opening workbook | Excel Programming | |||
Automatically add a textbox to a user form based on user requireme | Excel Programming | |||
User form ComboBox Items: Remember user entries? | Excel Programming | |||
Stopping repetitive loop execution through user form (or other ide | Excel Programming | |||
How to: User Form to assign a user defined range to a macro variab | Excel Programming |