Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Tratativa de erro.
 
Notifications
Clear all

Tratativa de erro.

 
Página 1 / 2
2024 - VBA & Macros
Post Recente por Lorenzon 9 anos atrás
16 Posts
4 Usuários
0 Reactions
3,753 Visualizações
RSS
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Pessoal,

Tenho um sistema de Controle de Despesas Pessoais que, por sinal, fiz até uma gravação dele e disponibilizei aqui no planilhando.com.

Ele cumpre o que promete! Mas eu ainda não posso disponibilizá-lo, pois, inexplicavelmente, o mesmo apresenta erro ao ser fechado.

Eu já abri um fórum sobre isso, mas não obtive respostas. Vejam abaixo:

http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=15207

Por conta disso, na esperança de resolver esse problema, estou já há alguns dias na tentativa e erro. Creio que eu já tenha resolvido boa parte dos erros, mas o que esta reincidindo é esse:

Alguém sabe quais são as possíveis causa desse erro?

 
Postado : 14/04/2015 8:39 am
 laennder
(@laennder)
Posts: 62
Trusted Member
 

Documentação da Microsoft

https://msdn.microsoft.com/pt-br/library/5szkzs17.aspx

Laennder Alves
Microsoft MVP

 
Postado : 14/04/2015 9:00 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Coloque o cõdigo da rotina MySub...

ou aonde cai a linha amarela quando o erro acontece...

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 14/04/2015 10:17 am
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Fernando,

Esse ''mySub'' tem o objetivo de evitar que, ao encerrar o excel/projeto, o mesmo fique na memória do computador.

Veja abaixo:

Application.OnKey "{Escape}", ""



Dim xlApp As Excel.Application

Dim xlWkb As Excel.Workbook

Dim blnIsOpen As Boolean

On Error GoTo ErrHandler



Set xlApp = New Excel.Application

blnIsOpen = True

Call fechar


xlApp.Quit

blnIsOpen = False

ExitHere:

Exit Sub

ErrHandler:


If blnIsOpen = True Then

    xlApp.Quit

End If

MsgBox Err.Description & vbCrLf & Err.Number & vbCrLf & Err.Source, vbCritical, "MySub"

Resume ExitHere

 
Postado : 14/04/2015 10:32 am
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Fernando,

Na verdade são macros de duas userform's que acarretam nesse erro.

1° mysub (eu exclui esse código, e o erro, lógico, sumiu, aparecendo apenas se eu abri a userform19.)

2° Eu não sei qual macro é, mas sei que é alguma da userform19, pois se eu não abrir essa userform, o erro não acontece.

Macros da userform19:

Dim tamanhoLargura, tamanhoAltura

Option Explicit


'listrado


Private Declare Function SetWindowLong& Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long _
, ByVal wCmd As Long) As Long

Private Const GWL_WNDPROC As Long = (-4&)

Private hwnd As Long



'icone


Private Declare Function ExibirÍcone Lib "user32" Alias "SendMessageA" ( _
            ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
            lParam As Any) As Long

Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
' o termo FindWindwA não pode ser alterado

'// Constante do Ícone
Private Const FOCO_ICONE = &H80
Private Const ICONE = 0&

'tamanho das colunas
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const LVM_FIRST = &H1000
Private Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE = -1
Private Const LVSCW_AUTOSIZE_USEHEADER = -2

Dim Form_Personalizado As Long
Dim hIcone As Long

Dim mclsFormChanger As CFormChanger


Dim nAtualizaForm As New Classeform










Private Const imprimir As String = "Relatorio"
Private Const NomeDaPlanilha As String = "cliente"
Private Const LinhaCabecalho As Integer = 1

'define constantes para controlar as colunas de dados
Const colcodigo As Integer = 1
Const colcliente As Integer = 2
Const colccusto As Integer = 3
Const colcrazão As Integer = 4
Const coltipo As Integer = 5
Const colsoma As Integer = 18
Const colmédia As Integer = 19
Const colentrada As Integer = 20




Const colsaída As Integer = 21
Const coltelefone As Integer = 22
Const colemail As Integer = 23




Const indiceMinimo As Byte = 2


'define variavies para controlar a
Private alterar As Boolean
Private novo As Boolean
Private excluir As Boolean

'define as constantes para as cores do textbox
Const corDesabilitaTextBox As Long = -2147483633
Const corHabilitaTextBox As Long = -2147483643

'define a planilha usada e o indice do registro
Private CadastroProdutos As Worksheet
Private indiceRegistro As Long



Private Sub combobox2_Change()
If ComboBox2.Text <> "" Then

Image65.Visible = True

Image67.Visible = False

End If
End Sub

Private Sub ComboBox2_Enter()
If ComboBox2.Text <> "" Then

Image65.Visible = True

Image67.Visible = False

End If

End Sub

Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Image67.Visible = True

Image65.Visible = False

End Sub

Private Sub ComboBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Image65.Visible = True

Image67.Visible = False

End Sub

Private Sub ComboBoxCampos_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub

Private Sub Frame17_Click()

TextBox59.Text = "tel"

Me.Hide

UserForm81.Show

End Sub

Private Sub Frame17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Frame17.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Frame18_Click()

End Sub

Private Sub Frame18_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Frame18.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Image22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image22.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Image23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image23.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Image24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image24.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Image25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image25.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image26.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image27.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image28_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image28.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Image28_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image28.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image29_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image29.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image30_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image30.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Image31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image31.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image32_Click()
Shell "calc.exe"
End Sub



Private Sub Image59_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)


Image59.SpecialEffect = fmSpecialEffectSunken

If txtproduto.Text = "" Then

Image59.ControlTipText = "Você ainda não selecionou um Cliente!"

Else

Image59.ControlTipText = "Insira-o na programação que você está fazendo!"

End If


End Sub

Private Sub CommandButton3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label43.Visible = True
End Sub



Private Sub Image66_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image66.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image68_Click()

On Error Resume Next

    If txtproduto.Text = "" Then

MsgBox "Gentileza selecionar um cliente!", vbCritical, "Atenção!"

Exit Sub

End If

Dim lastRow As Object


Sheets("GRAFICO_CLIENTE").Select

Set lastRow = Plan30.Range("a1:a1").End(xlUp)

lastRow.Offset(0, 0).Value = txtCodigo.Text

ThisWorkbook.Worksheets("GRAFICO_CLIENTE").Activate
Me.Hide

UserForm80.Show


End Sub

Private Sub Image32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image32.SpecialEffect = fmSpecialEffectSunken

End Sub

Private Sub Image65_Click()

If ComboBox2.Text = "" Then

MsgBox "Por favor, selecione o ano a ser pesquisado e Tente Novamente!", vbInformation, "Atenção!"

ComboBox2.SetFocus


Exit Sub

End If




If Label41.Caption = ComboBox2.Text Then

MsgBox "Os dados referentes a este ano estão carregados! Selecione outro ano e Tente Novamente!", vbInformation, "Atenção!"

Exit Sub

End If


Sheets("cliente").Select

 Dim lastRow As Object

Set lastRow = Plan22.Range("z:z").End(xlUp)


lastRow.Offset(0, 0).Value = ComboBox2.Value

   Call PreencherCabeçalhoLinhas
    Call formatação_lsLista
    Call formato_islista
    Image28.Enabled = False
    novo = False
    alterar = False
    excluir = False
    Set CadastroProdutos = ThisWorkbook.Worksheets("cliente")
    Call HabilitaBotoesAlteracao
    Call carregaDados
    Call DesabilitaControles
    Call LimpaControles
    Call atualizar
    Label41.Caption = ComboBox2.Text
    
    
   
   If TextBoxFiltro.Text <> "" Then
   
   Call TextBoxFiltro_Change
   
     
   Call TamanhoColAutomatico
   
   MsgBox "Pesquisa realizada com sucesso!", vbInformation, "Atenção!"
   
   Exit Sub
   
   End If
   
      If TextBoxFiltro.Text = "" Then
  
  
     
   Call TamanhoColAutomatico
   
   MsgBox "Pesquisa realizada com sucesso!", vbInformation, "Atenção!"
   
   Exit Sub
   
   End If
   
   
End Sub

Private Sub Label39_Click()

End Sub

Private Sub Image68_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image68.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Label57_Click()
Shell "calc.exe"
End Sub



Private Sub Lslista_ItemCheck(ByVal Item As MSComctlLib.ListItem)
Label104.Visible = True

Label96.Visible = True


Call Somar2

    Dim j As Integer
    If Item.Checked = True Then
            Item.ForeColor = RGB(0, 0, 255)      'Changement couleur
            'Item.Bold = True 'Gras
            Item.Selected = True
            
            For j = 1 To Item.ListSubItems.Count
                Item.ListSubItems(j).ForeColor = RGB(0, 0, 255)
                'Item.ListSubItems(j).Bold = True
                Item.Selected = True
            Next j
        Else
            Item.ForeColor = RGB(1, 0, 0) 'Changement couleur
            Item.Bold = False
            Item.Selected = False
         
            For j = 1 To Item.ListSubItems.Count
                Item.ListSubItems(j).ForeColor = RGB(1, 0, 0)
                
                Item.ListSubItems(j).Bold = False
                Item.Selected = False
            Next j
    End If
End Sub

Private Sub lslista_KeyDown(KeyCode As Integer, ByVal Shift As Integer)

Select Case KeyCode
Case vbKeyDelete


Call image22_Click

End Select

Select Case KeyCode
Case vbKeyF12 And TextBox34.Text = 1






Unload Me
UserForm9.Hide



End Select





End Sub

Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)

End Sub

Private Sub TextBox32_Change()
TextBox32 = Format(TextBox32, "Currency")
End Sub

Private Sub TextBox35_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)



End Sub

Private Sub TextBox35_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

KeyAscii = 0

If TextBox35.Locked = False Then

TextBox35.Text = ""


UserForm81.Show

End If


End Sub

Private Sub TextBox35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Frame17.SpecialEffect = fmSpecialEffectRaised

End Sub

Private Sub TextBox36_Change()

End Sub

Private Sub TextBox36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Frame18.SpecialEffect = fmSpecialEffectRaised
End Sub

Private Sub TextBox58_Change()
If TextBox58.Text = 0 Then

Frame5.Visible = False


Call OcultaColunas
Call TamanhoColAutomatico
End If


End Sub

Private Sub TextBoxFiltro_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Call OcultaColunas
Call TamanhoColAutomatico
Label10.Visible = False

Dim StringLength



  StringLength = Len(TextBoxFiltro.Text)
[TextBox58] = StringLength - 1

End Sub

Private Sub TextBoxFiltro_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim StringLength

If TextBox34.Text = "1" Then

Image22.Visible = True

Image25.Visible = True
Image26.Visible = True
Image27.Visible = True


Image66.Visible = True
Image31.Visible = False





Label10.Visible = True
  Call LimpaControles
  StringLength = Len(TextBoxFiltro.Text)
[TextBox58] = StringLength + 1


  
  End If
  
End Sub
Private Sub Somar2()


Dim valor2 As Double
Dim valor3 As Double


Dim i

For i = 1 To lslista.ListItems.Count

If lslista.ListItems.Item(i).Checked = False Then



Frame5.Visible = True

Else

On Error Resume Next


valor2 = valor2 + CDbl(Me.lslista.ListItems(i).ListSubItems(19))
             valor3 = valor3 + CDbl(Me.lslista.ListItems(i).ListSubItems(20))
                   
                   

End If
Next i

Label104.Caption = valor2
Label96.Caption = valor3


Label105.Caption = Format(Label96.Caption / TextBox54.Value, "0.00%")


Label106.Caption = Format(Label104.Caption / TextBox57.Value, "0.00%")



        


    End Sub
Private Sub UserForm_Activate()
Application.OnKey "{Escape}", ""


Set nAtualizaForm.Form = Me

        Form_Personalizado = FindWindowA(vbNullString, Me.Caption)
        Call ExibirÍcone(Form_Personalizado, FOCO_ICONE, ICONE, ByVal hIcone)
            
            Set mclsFormChanger = New CFormChanger
            Set mclsFormChanger.Form = Me
            
            mclsFormChanger.ShowTaskBarIcon = True

   
        
            
            
            
Call TamanhoColAutomatico
Call OcultaColunas

Label41.Caption = [af1]

hIcone = Image5.Picture.Handle
        Form_Personalizado = FindWindowA(vbNullString, Me.Caption)
        Call ExibirÍcone(Form_Personalizado, FOCO_ICONE, ICONE, ByVal hIcone)
            
            Set mclsFormChanger = New CFormChanger
            Set mclsFormChanger.Form = Me
            
            mclsFormChanger.ShowTaskBarIcon = True
            
            
            If TextBox34.Text = 1 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = True
Image31.Visible = False


Exit Sub

End If


            If TextBox34.Text = 2 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False


Exit Sub

End If

           If TextBox34.Text = 5 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False


Exit Sub

End If


        If TextBox34.Text = 3 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False


Exit Sub

End If

        If TextBox34.Text = 6 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False


Exit Sub

End If




End Sub
Private Sub TamanhoColAutomatico()
Dim Column As Long
Dim Counter As Long
Counter = 0
For Column = Counter To lslista.ColumnHeaders.Count - 2
SendMessage lslista.hwnd, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER
Next

Call OcultaColunas

End Sub
Private Sub btnOK_Click()

UserForm7.Show


End Sub


Sub formatação_lsLista()
                   With lslista
                     .View = lvwReport
                     .Gridlines = True
                     .Appearance = 1               '= 0 - ccFlat e 1- cc3d
                     .Arrange = 0                      '= 0 lvwNome / 1 lvwautoleft / 2 lvwautotop
                     .CheckBoxes = True       '= true ou false
                     '.ControlTipText =
                     .Enabled = True      ' true ou false
                     .FlatScrollBar = False    '= true ou false
                     .FullRowSelect = True   ' = true ou false
                     .Gridlines = True        '= true ou false
                    ' .Height
                     '.HelpContextID
                     .HideColumnHeaders = False  ' = true ou false
                     '.HideSelction = True       '= true ou false
                     .HotTracking = False        '= true ou false
                     .HoverSelection = False    '= true ou false
                     .LabelEdit = 1        '= 0 lvw automatic ou 1 - lvwmanual
                     .LabelWrap = True          ' = true ou false
                     .MultiSelect = False        '= true ou false
                     .OLEDragMode = ccOLEDragManual
                    End With

End Sub
Private Sub OcultaColunas()
   
    On Error Resume Next
    With lslista

       
        .ColumnHeaders(20).Width = 0
      .ColumnHeaders(21).Width = 0
        
        .ColumnHeaders(22).Width = 0
        
          .ColumnHeaders(23).Width = 0
        .ColumnHeaders(24).Width = 0
      .ColumnHeaders(25).Width = 0
        
        .ColumnHeaders(26).Width = 0
    
    .ColumnHeaders(27).Width = 0
        
        .ColumnHeaders(28).Width = 0
    End With


End Sub
Private Sub cbModal_Change()
nAtualizaForm.Modal = cbModal.Value
End Sub



Private Sub Image28_Click()

Application.OnKey "{Escape}", ""

TextBox37.Text = TextBox35.Text


alterar = True
Application.Visible = False
   

   
   If txtCodigo.Text <> vbNullString And txtCodigo.Text <> "" Then

        txtCodigo.Enabled = True
        Call HabilitaControles
        
        Call DesabilitaBotoesAlteracao
        'dá o foco ao primeiro controle de dados
        txtproduto.SetFocus
        
              
        Image28.Visible = False
        
        Frame17.Visible = True
        Frame18.Visible = True
        lslista.Enabled = False
        
    Else
        MsgBox "Não há registro a ser alterado"
        TextBoxFiltro = ""
        ComboBoxCampos = ""
        
          Frame17.Visible = False
          
        Frame18.Visible = False
    End If
End Sub


Sub trocar()

 txtCodigo.Enabled = True
        Call HabilitaControles
        
        Call DesabilitaBotoesAlteracao
        'dá o foco ao primeiro controle de dados
        txtproduto.SetFocus
        
              
        Image28.Visible = False
        
        Frame17.Visible = True
        Frame18.Visible = True
        lslista.Enabled = False
        
        TextBox59.Text = ""
        
End Sub
Private Sub Image24_Click()
Application.OnKey "{Escape}", ""



            If TextBox34.Text = 1 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = True
Image31.Visible = False
 Frame17.Visible = False
          
        Frame18.Visible = False
Call arrumar

lslista.Enabled = True



Exit Sub

End If


            If TextBox34.Text = 2 Then

 Frame17.Visible = False
          
        Frame18.Visible = False
Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False
lslista.Enabled = True
Call arrumar

Exit Sub

End If

          If TextBox34.Text = 3 Then

 Frame17.Visible = False
          
        Frame18.Visible = False
Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False
lslista.Enabled = True
Call arrumar

Exit Sub

End If


End Sub


Sub arrumar()
  Sheets("cliente").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    TextBoxFiltro.SetFocus
    Call PreencheCampos
    Me.ComboBoxCampos.ListIndex = 1
    PreencherListView
    
    Call PreencherCabeçalhoLinhas
    Call formatação_lsLista
   
    Image28.Enabled = False
    novo = False
    alterar = False
    excluir = False
    Set CadastroProdutos = ThisWorkbook.Worksheets("cliente")
    Call HabilitaBotoesAlteracao
    Call carregaDados
    Call DesabilitaControles
    Call LimpaControles
    Call atualizar


Call TamanhoColAutomatico





    
    
    
    
 Call formato_islista
 
End Sub
Private Sub image22_Click()
Application.OnKey "{Escape}", ""
If txtCodigo.Text = "1" Then

MsgBox "Este registro é padrão do sistema e não aceita exclusão!", vbInformation, "Padrão"

Exit Sub

End If


Application.Visible = False
    excluir = True
    If txtCodigo.Text <> vbNullString And txtCodigo.Text <> "" Then
        Call DesabilitaBotoesAlteracao
        
    
        'MsgBox "Você confirma a exclusão deste registro. (Para excluir clique no botão OK.) "
        
    Else
       MsgBox "Não existe registro a ser excluído", , "Cadastro"
       
       Exit Sub
       
    End If
    

      Dim RESULTADO As VbMsgBoxResult
        RESULTADO = MsgBox("Deseja excluir o registro nº " & txtCodigo.Text & " ?", vbYesNo, "Confirmação")

        If RESULTADO = vbYes Then
            CadastroProdutos.Range(CadastroProdutos.Cells(indiceRegistro, colcodigo), CadastroProdutos.Cells(indiceRegistro, colcodigo)).EntireRow.Delete
            
            MsgBox "O Registro escolhido foi excluído com sucesso.", , "Cadastro"
            txtCodigo.Enabled = False
          
        Call LimpaControles
    Call TextBoxFiltro_Change
     Call TamanhoColAutomatico


 If TextBox34.Text = 1 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = True
Image31.Visible = False


Exit Sub

End If


            If TextBox34.Text = 2 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False


Exit Sub

End If

           If TextBox34.Text = 3 Then


Image22.Visible = True




Image25.Visible = True
Image26.Visible = True
Image27.Visible = True
Image29.Visible = True
Image66.Visible = False

Image31.Visible = False


Exit Sub

End If






End If


Exit Sub
    


End Sub





Private Sub Image30_Click()
Application.OnKey "{Escape}", ""

Application.Visible = False
   
    
    
    Dim proximoId As Long


Dim controle As Control
Dim str As String
Dim chk As TextBox
For Each controle In Me.Controls
  If TypeName(controle) = "textbox" Then
    str = str & controle.Caption & ","
  End If
Next



UserForm20.TextBox19 = UserForm19.TextBox34 & str
    
    
  
 
    UserForm19.Hide
    
    
    UserForm20.Show
    
    
    
 
End Sub



Private Sub Image23_Click()

If txtproduto.Text = "" Then

MsgBox "Por favor, selecione um Cliente/fornecedor e tente novamente!", vbInformation, "Atenção!"

Exit Sub

End If




Application.OnKey "{Escape}", ""

Application.Visible = False
If alterar = True Then
    
  

     
    
        Call SalvaRegistro(CDbl(txtCodigo.Text), indiceRegistro)
        MsgBox "O Registro alterado com sucesso.", , "Cadastro"
      
        txtCodigo.Enabled = False
        Call PreencherCabeçalhoLinhas
        Call LimpaControles
        Call atualizar
                Call DesabilitaControles
        Call DesabilitaBotoesAlteracao
        
        
         Image27.Visible = True
    
    Image26.Visible = True

Call LimpaControles
Call TextBoxFiltro_Change

Call TamanhoColAutomatico
lslista.Enabled = True
Exit Sub


End If
 
  

    

    
 

End Sub
Private Sub SalvaRegistro(ByVal id As Long, ByVal Indice As Long)

    With CadastroProdutos

    
Dim linha, Index
Dim i As Integer

Dim indiceRegistro As Long

Dim oList As Object
Dim j

    On Error Resume Next
    
    
        Set oList = lslista.SelectedItem
        
      
        If oList Is Nothing Then
             
Exit Sub

End If
    
    
        .Cells(Indice, colcodigo).Value = id
        .Cells(Indice, colcliente).Value = Me.txtproduto.Text
        .Cells(Indice, colcrazão).Value = Me.txtunidade.Text
        .Cells(Indice, coltipo).Value = Me.txtvalorp.Text
        .Cells(Indice, colccusto).Value = Me.TextBox1.Text
        
        
        
       .Cells(Indice, coltelefone).Value = Me.TextBox35.Text
        .Cells(Indice, colemail).Value = Me.TextBox36.Text
  
        
  
               




    End With

    Call AtualizaRegistroAtual
    
   
End Sub

Private Sub CarregaRegistro()
    'carrega os dados do primeiro registro
    With CadastroProdutos
        If Not IsEmpty(.Cells(indiceRegistro, colcliente)) Then
            Me.txtCodigo.Text = .Cells(indiceRegistro, colcodigo).Value
            Me.txtproduto.Text = .Cells(indiceRegistro, colcliente).Value
           
            Me.txtunidade.Text = .Cells(indiceRegistro, colcrazão).Value
            Me.txtvalorp.Text = .Cells(indiceRegistro, coltipo).Value
            Me.TextBox1.Text = .Cells(indiceRegistro, colccusto).Value
         
           
           Me.TextBox32.Text = .Cells(indiceRegistro, colsoma).Value
        
        Me.TextBox35.Text = .Cells(indiceRegistro, coltelefone).Value
        
        
        Me.TextBox36.Text = .Cells(indiceRegistro, colemail).Value
          
            
            
           
        End If
    End With

    Call AtualizaRegistroAtual
   
End Sub
Private Sub carregaDados()
    indiceRegistro = 2
    Call CarregaRegistro
End Sub

Private Sub AtualizaRegistroAtual()
    lblRegistro.Caption = indiceRegistro - 1 & " de " & CadastroProdutos.UsedRange.Rows.Count - 1
    'lblMensagem.Caption = ""
End Sub

Private Function ObterProximoId() As Long
    Dim rangeIds As Range
    'pega o range que se refere a toda a coluna do código (id)
    Set rangeIds = CadastroProdutos.Range(CadastroProdutos.Cells(indiceMinimo, colcodigo), CadastroProdutos.Cells(CadastroProdutos.UsedRange.Rows.Count, colcodigo))
    ObterProximoId = WorksheetFunction.max(rangeIds) + 1
End Function









Private Sub CarregaProdutos(ByVal Categoria As String)
    Dim linha As Integer, colunaproduto As Integer, colunaCategoria As Integer
    linha = 2
    colunaproduto = 1
    colunaCategoria = 2
    With Sheets("Produtos")
        Do While Not IsEmpty(.Cells(linha, colunaproduto))
            If .Cells(linha, colunaCategoria).Value = Categoria Then
            End If
            linha = linha + 1
        Loop
    End With
    
    End Sub




Private Sub CommandButton1_Click()

Application.OnKey "{Escape}", ""

Application.Visible = False


Unload Me

Unload frmComboBoxEncadeado











End Sub



Private Sub Image59_Click()
Application.OnKey "{Escape}", ""

If TextBox34.Text = 1 Then

MsgBox "Identifiquei que, no momento, nenhuma programação encontra-se em andamento e, por conta disso, a opção de Selecionar não está ativa!", vbInformation, "Atenção!"


Image59.Enabled = False

Exit Sub

End If



Application.Visible = False
If txtproduto.Text = "" Then


MsgBox "Gentileza selecionar um cliente!", vbCritical, "Atenção!"

Exit Sub

End If

If TextBox34.Text = 2 Then


Dim proximoId As Long


Dim controle As Control
Dim str As String
Dim chk As TextBox
For Each controle In Me.Controls
  If TypeName(controle) = "textbox" Then
    str = str & controle.Caption & ","
  End If
Next



frmComboBoxEncadeado.TextBox18 = UserForm19.txtproduto & str





frmComboBoxEncadeado.TextBox20 = UserForm19.TextBox1 & str


frmComboBoxEncadeado.TextBox21 = UserForm19.txtunidade & str


frmComboBoxEncadeado.TextBox22 = UserForm19.txtvalorp & str


frmComboBoxEncadeado.TextBox23 = UserForm19.txtCodigo & str






frmComboBoxEncadeado.entrou
Unload Me
frmComboBoxEncadeado.Show




Sheets("real").Select


Exit Sub

End If

If TextBox34.Text = 3 Then


For Each controle In Me.Controls
  If TypeName(controle) = "textbox" Then
    str = str & controle.Caption & ","
  End If
Next



frmComboBoxEncadeado.TextBox18 = UserForm19.txtproduto & str





frmComboBoxEncadeado.TextBox20 = UserForm19.TextBox1 & str


frmComboBoxEncadeado.TextBox21 = UserForm19.txtunidade & str


frmComboBoxEncadeado.TextBox22 = UserForm19.txtvalorp & str


frmComboBoxEncadeado.TextBox23 = UserForm19.txtCodigo & str

If frmComboBoxEncadeado.TextBox1.Text = "" Then

frmComboBoxEncadeado.TextBox1.SetFocus

End If

If frmComboBoxEncadeado.TextBox1.Text <> "" And frmComboBoxEncadeado.TextBox19.Text = "" Then
On Error Resume Next

frmComboBoxEncadeado.TextBox19.SetFocus


frmComboBoxEncadeado.TextBox19.BackColor = &H80000018
End If





If frmComboBoxEncadeado.TextBox1.Text <> "" Then

On Error Resume Next



frmComboBoxEncadeado.TextBox19.SetFocus


frmComboBoxEncadeado.TextBox19.BackColor = &H80000018
End If



frmComboBoxEncadeado.entrou

Unload Me


frmComboBoxEncadeado.Show



Sheets("real").Select


Exit Sub

End If

































If TextBox34.Text = 5 Then

For Each controle In Me.Controls
  If TypeName(controle) = "textbox" Then
    str = str & controle.Caption & ","
  End If
Next


UserForm9.TextBox38 = UserForm19.txtproduto & str


UserForm9.TextBox1 = UserForm19.TextBox1 & str


UserForm9.txtunidade = UserForm19.txtunidade & str


UserForm9.txtvalorp = UserForm19.txtvalorp & str


UserForm9.txtCodigo = UserForm19.txtCodigo & str


Unload Me


UserForm9.Show

Sheets("real").Select


Exit Sub

End If





If TextBox34.Text = 6 Then


For Each controle In Me.Controls
  If TypeName(controle) = "textbox" Then
    str = str & controle.Caption & ","
  End If
Next





UserForm46.TextBox18 = UserForm19.txtproduto & str


UserForm46.TextBox20 = UserForm19.TextBox1 & str


UserForm46.TextBox21 = UserForm19.txtunidade & str


UserForm46.TextBox25 = UserForm19.txtvalorp & str


UserForm46.TextBox26 = UserForm19.txtCodigo & str



Unload Me


UserForm46.Show




Exit Sub

End If





End Sub

Private Sub CommandButton3_Click()

Shell "calc.exe"

Label43.Visible = True


End Sub

Private Sub Label23_Click()


Dim iLin As Integer
    Dim rgCellInicio As Range
    Dim wsRelat As Worksheet
    Dim UltimaLinha As Long
    
    Set wsRelat = ThisWorkbook.Worksheets(imprimir)

    UltimaLinha = wsRelat.UsedRange.Rows.Count
    
    wsRelat.Range("A2:" & "o" & UltimaLinha).ClearContents
    
    Set rgCellInicio = wsRelat.Range("A65536").End(xlUp).Offset(1, 0)

        'recuperar dados
         Dim i As Integer, j As Integer
            
            'Loop nas linhas
            For i = 1 To lslista.ListItems.Count
                
                iLin = iLin + 1
                
                        rgCellInicio.Cells(iLin, 1).Value = lslista.ListItems(i).Text
                
                    'Loop nas colunas
                    For j = 1 To lslista.ColumnHeaders.Count - 1
                        rgCellInicio.Cells(iLin, j + 1).Value = lslista.ListItems(i).ListSubItems(j).Text
                    Next j
            Next i
            
     
            
            Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        
            Cells.Select
    Cells.EntireColumn.AutoFit
    End With
    
    Sheets("relatorio").Select
    
    Unload Me
    
    
    
        
    
  
    
End Sub

Private Sub Label24_Click()
 Dim iLin As Integer
    Dim rgCellInicio As Range
    Dim wsRelat As Worksheet
    Dim UltimaLinha As Long
    
    Set wsRelat = ThisWorkbook.Worksheets(imprimir)

    UltimaLinha = wsRelat.UsedRange.Rows.Count
    
    wsRelat.Range("A2:" & "o" & UltimaLinha).ClearContents
    
    Set rgCellInicio = wsRelat.Range("A65536").End(xlUp).Offset(1, 0)

        'recuperar dados
         Dim i As Integer, j As Integer
            
            'Loop nas linhas
            For i = 1 To lslista.ListItems.Count
                
                iLin = iLin + 1
                
                        rgCellInicio.Cells(iLin, 1).Value = lslista.ListItems(i).Text
                
                    'Loop nas colunas
                    For j = 1 To lslista.ColumnHeaders.Count - 1
                        rgCellInicio.Cells(iLin, j + 1).Value = lslista.ListItems(i).ListSubItems(j).Text
                    Next j
            Next i
            
     
            
            Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        
            Cells.Select
    Cells.EntireColumn.AutoFit
    End With
    
        
    
    wsRelat.Activate
    Macro1
    Macro3
    Macro2
    
    
End Sub



Private Sub Label9_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label23.Visible = True
Label24.Visible = True
End Sub





Private Sub lslista_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)













End Sub



Private Sub txtproduto_Change()
txtproduto = UCase(txtproduto)
End Sub



Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
UserForm19.Hide


If TextBox34 = 1 Then


Unload Me

UserForm9.Show

Exit Sub

End If


If TextBox34 = 2 Then

'menu iniciar

Unload Me

UserForm7.Show

Exit Sub

End If

If TextBox34 = 3 Then

'menu iniciar

Unload Me

frmComboBoxEncadeado.Show

Exit Sub

End If

If TextBox34 = 4 Then



Unload Me

UserForm12.Show

Exit Sub

End If

If TextBox34 = 5 Then

'menu iniciar

Unload Me

UserForm9.Show

Exit Sub

End If





End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image30.SpecialEffect = fmSpecialEffectRaised
Image28.SpecialEffect = fmSpecialEffectRaised
Image22.SpecialEffect = fmSpecialEffectRaised
Image23.SpecialEffect = fmSpecialEffectRaised
Image24.SpecialEffect = fmSpecialEffectRaised
Image32.SpecialEffect = fmSpecialEffectRaised
Frame17.SpecialEffect = fmSpecialEffectRaised


Image66.SpecialEffect = fmSpecialEffectRaised
Image25.SpecialEffect = fmSpecialEffectRaised
Image29.SpecialEffect = fmSpecialEffectRaised
Image31.SpecialEffect = fmSpecialEffectRaised
Image26.SpecialEffect = fmSpecialEffectRaised
Image27.SpecialEffect = fmSpecialEffectRaised
Image68.SpecialEffect = fmSpecialEffectRaised
Image59.SpecialEffect = fmSpecialEffectRaised
Frame18.SpecialEffect = fmSpecialEffectRaised


If TextBox59.Text = "tel" Then
    
    Call trocar
    
    End If
    
    



End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then

UserForm19.Hide




      If TextBox34 = 1 Then


Unload Me

UserForm9.Show

Exit Sub

End If


If TextBox34 = 2 Then

'menu iniciar

Unload Me


Unload UserForm19

UserForm7.Show

Exit Sub

End If

If TextBox34 = 3 Then

'menu iniciar

Unload Me

frmComboBoxEncadeado.Show

Exit Sub

End If

If TextBox34 = 4 Then



Unload Me

UserForm12.Show

Exit Sub

End If

If TextBox34 = 5 Then

'menu iniciar

Unload Me

UserForm9.Show

Exit Sub

End If
       
    End If
End Sub





Private Sub UserForm_Initialize()
Application.OnKey "{Escape}", ""


Dim i&

    hwnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
    


OldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)

Label41.Caption = [af1]

TextBox32.Text = ""




With Me
.Top = Application.Top
.Left = Application.Left
.Height = Application.Height
.Width = Application.Width



ComboBox2.AddItem "2015"
ComboBox2.AddItem "2014"
ComboBox2.AddItem "2013"




    UserForm19.Caption = "Clientes Cadastrados."
    
    Sheets("cliente").Select
    
    
    
    
If [x1] < 2 Then

userform27.Show

Exit Sub

End If
    
    
    
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    TextBoxFiltro.SetFocus
    Call PreencheCampos
    Me.ComboBoxCampos.ListIndex = 1
    
    
    Call PreencherCabeçalhoLinhas
    Call formatação_lsLista
   
    Image28.Enabled = False
    novo = False
    alterar = False
    excluir = False
    Set CadastroProdutos = ThisWorkbook.Worksheets("cliente")
    Call HabilitaBotoesAlteracao
    Call carregaDados
    Call DesabilitaControles
    Call LimpaControles
    
    
    
    
   


Call formatação_lsLista





    
    
    
    

 
    Call somar
    
    
    
    
    

    End With
    




    
End Sub


Sub ajeitar()

Sheets("cliente").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    TextBoxFiltro.SetFocus
    Call PreencheCampos
    Me.ComboBoxCampos.ListIndex = 1
    PreencherListView
    
    Call PreencherCabeçalhoLinhas
    Call formatação_lsLista
   
    Image28.Enabled = False
    novo = False
    alterar = False
    excluir = False
    Set CadastroProdutos = ThisWorkbook.Worksheets("cliente")
    Call HabilitaBotoesAlteracao
    Call carregaDados
    Call DesabilitaControles
    Call LimpaControles
    Call atualizar
     Call TamanhoColAutomatico






    
    
    
    
 Call formato_islista
 
    

    
    
End Sub
Private Sub CarregaCategorias()
    Dim linha As Integer, coluna As Integer
    linha = 1
    coluna = 5
    Me.ComboBox2.Clear
    With Sheets("cliente")
        Do While Not IsEmpty(.Cells(linha, coluna))
            Me.ComboBox2.AddItem .Cells(linha, coluna).Value
            linha = linha + 1
        Loop
    End With
    End Sub
Private Sub cmdPrimeiro_Click()
   
    indiceRegistro = indiceMinimo
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub cmdProximo_Click()
    
    If indiceRegistro < CadastroProdutos.UsedRange.Rows.Count Then
        indiceRegistro = indiceRegistro + 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub cmdUltimo_Click()
    
    indiceRegistro = CadastroProdutos.UsedRange.Rows.Count
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub Image1_Click()
      
    indiceRegistro = indiceMinimo
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub Image2_Click()
If indiceRegistro > indiceMinimo Then
        indiceRegistro = indiceRegistro - 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub Image3_Click()
  
    If indiceRegistro < CadastroProdutos.UsedRange.Rows.Count Then
        indiceRegistro = indiceRegistro + 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub Image4_Click()
    
    indiceRegistro = CadastroProdutos.UsedRange.Rows.Count
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub Label11_Click()
PDF
End Sub

Private Sub Label7_Click()
Unload UserForm19

   Application.WindowState = xlMinimized
Application.WindowState = xlMaximized
  Plan22.Select
 Application.Visible = True
End Sub


Private Sub Label8_Click()
 ActiveWorkbook.Save
Application.Quit
Unload UserForm19
End Sub

Private Sub Label9_Click()

    Dim iLin As Integer
    Dim rgCellInicio As Range
    Dim wsRelat As Worksheet
    Dim UltimaLinha As Long
    
    Set wsRelat = ThisWorkbook.Worksheets(imprimir)

    UltimaLinha = wsRelat.UsedRange.Rows.Count
    
    wsRelat.Range("A2:" & "o" & UltimaLinha).ClearContents
    
    Set rgCellInicio = wsRelat.Range("A65536").End(xlUp).Offset(1, 0)

        'recuperar dados
         Dim i As Integer, j As Integer
            
            'Loop nas linhas
            For i = 1 To lslista.ListItems.Count
                
                iLin = iLin + 1
                
                        rgCellInicio.Cells(iLin, 1).Value = lslista.ListItems(i).Text
                
                    'Loop nas colunas
                    For j = 1 To lslista.ColumnHeaders.Count - 1
                        rgCellInicio.Cells(iLin, j + 1).Value = lslista.ListItems(i).ListSubItems(j).Text
                    Next j
            Next i
            
     
            
            Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        
            Cells.Select
    Cells.EntireColumn.AutoFit
    End With
    
        
    
    wsRelat.Activate
    
    Macro3
    Macro2
    
    
    
End Sub



Private Sub CheckBox1_Click()

If CheckBox1.Value = True Then


Dim i

For i = 1 To lslista.ListItems.Count

If lslista.ListItems.Item(i).Checked = False Then

lslista.ListItems.Item(i).Checked = True
Call Somar2
End If


Next i


Exit Sub

End If



If CheckBox1.Value = False Then

For i = 1 To lslista.ListItems.Count

If lslista.ListItems.Item(i).Checked = True Then

lslista.ListItems.Item(i).Checked = False
Call Somar2
End If

Next i

Exit Sub

End If


If CheckBox1.Value = "" Then

For i = 1 To lslista.ListItems.Count

If lslista.ListItems.Item(i).Checked = True Then

lslista.ListItems.Item(i).Checked = False
Call Somar2
End If

Next i

Exit Sub

End If

End Sub


Private Sub somar()




        Dim i As Long
   
        Dim valor2 As Double
        Dim valor3 As Double
      
        
        
        
        On Error Resume Next
        
        
        For i = 1 To Me.lslista.ListItems.Count
             On Error Resume Next

             valor2 = valor2 + CDbl(Me.lslista.ListItems(i).ListSubItems(19))
             valor3 = valor3 + CDbl(Me.lslista.ListItems(i).ListSubItems(20))
                   
                  
             
             
        Next i
        
        TextBox57.Text = valor2
        TextBox54.Text = valor3
       
        
             
        
        Frame5.Visible = True
        
      


Call OcultaColunas


    End Sub





Private Sub lslista_Click()




Dim linha, Index
Dim i As Integer

Dim indiceRegistro As Long

        


Dim oList As Object
Dim j

    On Error Resume Next
        Set oList = lslista.SelectedItem
        If oList Is Nothing Then
           
Exit Sub


    
    
    
    
End If

            indiceRegistro = UserForm19.ProcuraIndiceRegistroPodId(lslista.ListItems.Item(lslista.SelectedItem.Index))
                     If indiceRegistro <> -1 Then
                        Call UserForm19.CarregaRegistroPorIndice(indiceRegistro)
                        
                        
                        
                    End If
                   
       

           If TextBox34.Text = "1" Then
       Image22.Enabled = True
       Image25.Visible = False
       Image22.Visible = True
              

 
  
  
  
Exit Sub

End If


 If TextBox34.Text = 2 Then
       
 
    Image22.Enabled = True
    Image25.Visible = False
    Image22.Visible = True
              


Exit Sub

End If
    
  
    

    
    


    
    
    








End Sub

 
                
  
     
     
     
    
    
  

Private Sub lsLista_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

    
   On Error Resume Next
    
    Dim vbHourglass
    Dim InvNumber
    
  
    
    ' Começa ordenar o listview pela coluna clicada
    
    With lslista
    
        ' Display the hourglass cursor whilst sorting
        
        Dim lngCursor As Long
        lngCursor = .MousePointer
        .MousePointer = vbHourglass
        
        ' Prevent the ListView control from updating on screen -
        ' this is to hide the changes being made to the listitems
        ' and also to speed up the sort
        
        
        
        ' Check the data type of the column being sorted,
        ' and act accordingly
        
        Dim l As Long
        Dim strFormat As String
        Dim strData() As String
        
        Dim lngIndex As Long
        lngIndex = ColumnHeader.Index - 1
    
        Select Case UCase$(ColumnHeader.Tag)
        Case "DATE"
        
            ' Sort by date.
            
            strFormat = "YYYYMMDDHhNnSs"
        
            ' Loop through the values in this column. Re-format
            ' the dates so as they can be sorted alphabetically,
            ' having already stored their visible values in the
            ' tag, along with the tag's original value
        
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsDate(.Text) Then
                                .Text = Format(CDate(.Text), _
                                                    strFormat)
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsDate(.Text) Then
                                .Text = Format(CDate(.Text), _
                                                    strFormat)
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                End If
            End With
            
            ' Sort the list alphabetically by this column
            
            .SortOrder = (.SortOrder + 1) Mod 2
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
            
            ' Restore the previous values to the 'cells' in this
            ' column of the list from the tags, and also restore
            ' the tags to their original values
            
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                End If
            End With
            
        Case "NUMBER"
        
            ' Sort Numerically
        
            strFormat = String(30, "0") & "." & String(30, "0")
        
            ' Loop through the values in this column. Re-format the values so as they
            ' can be sorted alphabetically, having already stored their visible
            ' values in the tag, along with the tag's original value
        
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsNumeric(.Text) Then
                                If CDbl(.Text) >= 0 Then
                                    .Text = Format(CDbl(.Text), _
                                        strFormat)
                                Else
                                    .Text = "&" & InvNumber( _
                                        Format(0 - CDbl(.Text), _
                                        strFormat))
                                End If
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsNumeric(.Text) Then
                                If CDbl(.Text) >= 0 Then
                                    .Text = Format(CDbl(.Text), _
                                        strFormat)
                                Else
                                    .Text = "&" & InvNumber( _
                                        Format(0 - CDbl(.Text), _
                                        strFormat))
                                End If
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                End If
            End With
            
            ' Sort the list alphabetically by this column
            
            .SortOrder = (.SortOrder + 1) Mod 2
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
            
            ' Restore the previous values to the 'cells' in this
            ' column of the list from the tags, and also restore
            ' the tags to their original values
            
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                End If
            End With
        
        Case Else   ' Assume sort by string
            
            ' Sort alphabetically. This is the only sort provided
            ' by the MS ListView control (at this time), and as
            ' such we don't really need to do much here
        
            .SortOrder = (.SortOrder + 1) Mod 2
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
            
        End Select
    
      
        
        .MousePointer = lngCursor
    
    End With
    
    

    
    
    Image28.Enabled = False
    Image22.Enabled = True

End Sub

Private Sub lslista_DblClick()
Dim linha, Index
Dim i As Integer

Dim indiceRegistro As Long

        


Dim oList As Object
Dim j

    On Error Resume Next
        Set oList = lslista.SelectedItem
        If oList Is Nothing Then
           
Exit Sub


    
    
    
    
End If
            indiceRegistro = UserForm19.ProcuraIndiceRegistroPodId(lslista.ListItems.Item(lslista.SelectedItem.Index))
                     If indiceRegistro <> -1 Then
                        Call UserForm19.CarregaRegistroPorIndice(indiceRegistro)
                    End If
            
             If TextBox34.Text = "1" Then
       

    Image59.Enabled = False
    
    Image30.Enabled = False

    Image28.Enabled = True
    Image22.Enabled = False

Image29.Visible = False
Image28.Visible = True
Image25.Visible = True




Else
    
   Image59.Enabled = True
   
    
    Image30.Enabled = False

    Image28.Enabled = True
    Image22.Enabled = False

Image29.Visible = False
Image28.Visible = True
Image25.Visible = True
    
    End If
    
End Sub

Private Sub LimpaControles()
    Me.txtCodigo.Text = ""
    Me.txtproduto.Text = ""

    Me.txtunidade.Text = ""
    Me.txtvalorp.Text = ""
    Me.TextBox1.Text = ""
    Me.TextBox32.Text = ""
    Me.TextBox4.Text = ""
    Me.TextBox6.Text = ""
     Me.TextBox35.Text = ""
    Me.TextBox36.Text = ""

End Sub

Private Sub HabilitaControles()
    Me.txtproduto.Locked = False

    
   
    
    

    Me.TextBox4.Locked = False
    Me.TextBox35.Locked = False
    Me.TextBox36.Locked = False

     
     
     


    'altera a cor dos controles
    Me.txtproduto.BackColor = corHabilitaTextBox

Me.TextBox35.BackColor = corHabilitaTextBox
Me.TextBox36.BackColor = corHabilitaTextBox
   
   
    
  
   
    Me.TextBox4.BackColor = corHabilitaTextBox
    Me.TextBox6.BackColor = corHabilitaTextBox
 

 
    

End Sub

Private Sub DesabilitaControles()
    Me.txtproduto.Locked = True
   
  
    Me.txtunidade.Locked = True
    Me.txtvalorp.Locked = True
    Me.TextBox1.Locked = True
    Me.TextBox4.Locked = True
    Me.TextBox35.Locked = True
    Me.TextBox36.Locked = True
  
   
  

    'altera a cor dos controles
    Me.txtproduto.BackColor = corDesabilitaTextBox

    Me.TextBox1.BackColor = corDesabilitaTextBox
    
    Me.txtvalorp.BackColor = corDesabilitaTextBox
    Me.txtunidade.BackColor = corDesabilitaTextBox
    Me.TextBox4.BackColor = corDesabilitaTextBox
    Me.TextBox6.BackColor = corDesabilitaTextBox
    Me.TextBox35.BackColor = corDesabilitaTextBox
    Me.TextBox36.BackColor = corDesabilitaTextBox
    



End Sub

Private Sub HabilitaBotoesAlteracao()
   'habilita os botões de alteração
    Image28.Enabled = False
    Image22.Enabled = False
    Image30.Enabled = True
    Image23.Enabled = False
    Image24.Enabled = False
End Sub

Private Sub DesabilitaBotoesAlteracao()
'desabilita os botões de alteração
    Image28.Enabled = False
    Image22.Enabled = True
    
    
    Image26.Visible = False
    Image27.Visible = False
    Image29.Visible = True
    Image31.Visible = True
        Image66.Visible = True
        

    Image30.Enabled = False
 
    Image24.Enabled = True
    Image23.Enabled = True
End Sub

Private Function ValidaCamposFormulario() As Boolean

If Me.txtproduto.Value = "" Then
  MsgBox " 'Matrícula' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
  Me.txtproduto.SetFocus
  ValidaCamposFormulario = False
  Exit Function


  
ElseIf Me.txtunidade.Value = "" Then
  MsgBox "'Setor' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
  Me.txtunidade.SetFocus
  ValidaCamposFormulario = False
  Exit Function
ElseIf Me.txtvalorp.Value = "" Then
  MsgBox " 'Cargo' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
  Me.txtvalorp.SetFocus
  ValidaCamposFormulario = False
  Exit Function
  ElseIf Me.ComboBox3.Value = "" Then
  MsgBox "'Status' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
  Me.ComboBox3.SetFocus
  ValidaCamposFormulario = False

  Exit Function
  
  

End If
ValidaCamposFormulario = True
End Function

  Private Sub PreencherCabeçalhoLinhas()
    
        Dim Ws As Worksheet
        Dim coluna As Integer
        Dim linha As Integer
        Dim itm As ListItem, n As Long, lngCol As Long
        Dim vardata As Variant
        
        Call atualizar
        
        Set Ws = ThisWorkbook.Worksheets(NomeDaPlanilha)
        
            coluna = 1
            linha = LinhaCabecalho
            
            Me.lslista.ListItems.Clear
            Me.lslista.ColumnHeaders.Clear
        
        vardata = Ws.Range("b1").CurrentRegion.Value
        
        With Ws
            While .Cells(linha, coluna).Value <> Empty
                   With lslista
                     .View = lvwReport
                     .Gridlines = True
                     .ColumnHeaders.Add Text:=Ws.Cells(linha, coluna), Width:=Ws.Cells(linha, coluna).Width
                   
                   End With
                coluna = coluna + 1
            Wend
            
            'Preenche as Linhas
            With lslista
                    For n = 2 To UBound(vardata)
                        Set itm = .ListItems.Add(n - 1, , vardata(n, 1))
                            For lngCol = 2 To UBound(vardata, 2)
                        
                                'verifica se é Data e formata a Coluna
                                If IsDate(vardata(n, lngCol)) Then
                        itm.ListSubItems.Add , , vardata(n, lngCol)
                                    
                                   ' itm.ListSubItems.Add , , Format(vardata(n, lngCol), "R$ #,##0.00")
                                Else
                                    itm.ListSubItems.Add , , vardata(n, lngCol)
                                End If
                            
                            Next lngCol
                    Next n
                End With
                
        
            
        End With

    End Sub

End Sub
 
Postado : 14/04/2015 11:06 am
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

... continuação

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Image1.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Image2.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub Image3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Image3.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub Image4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Image4.SpecialEffect = fmSpecialEffectRaised
End Sub


Sub atualizar()
Dim rngCelula As Range
ActiveWorkbook.Sheets("cliente").Activate
Range("l9000").Select

  For Each rngCelula In Selection
    rngCelula.FormulaLocal = rngCelula.Value
  Next rngCelula
  [b1].Select
  
   
  
End Sub

Public Function ProcuraIndiceRegistroPodId(ByVal id As Long) As Long
    Dim i As Long
    Dim retorno As Long
    Dim encontrado As Boolean

    i = indiceMinimo
    With CadastroProdutos
        Do While Not IsEmpty(.Cells(i, colcodigo))
            If .Cells(i, colcodigo).Value = id Then
                retorno = i
                encontrado = True
                Exit Do
            End If
            i = i + 1
        Loop
    End With

    'caso não encontre o registro, retorna -1
    If Not encontrado Then
        retorno = -1
    End If

    ProcuraIndiceRegistroPodId = i
End Function
Public Sub CarregaRegistroPorIndice(ByVal Indice As Long)
'carrega os dados do registro baseado no índice
    indiceRegistro = Indice

    Call CarregaRegistro
End Sub

Sub formato_islista()
Me.Label10.Caption = "Total de Dados: " & Format(Me.lslista.ListItems.Count, "000")
' para formatar é aqui
 ' para formatar é aqui
    Dim X As Integer
    For X = 1 To lslista.ListItems.Count
        Me.lslista.ListItems(X).SubItems(18) = Format(Me.lslista.ListItems(X).SubItems(18), "0.00")
     Next X ' loop
End Sub

Private Sub ComboBoxCampos_Change()
'Me.TextBoxFiltro.SetFocus
End Sub

Sub PreencherListView()
Dim lastRow As Long
Dim li As ListItem
Dim X As Long

'limpar
lslista.ListItems.Clear
    
    lastRow = Plan22.Cells(Plan22.Cells.Rows.Count, "a").End(xlUp).Row
    
    ' Adiciona itens
   For X = 2 To lastRow
        Set li = lslista.ListItems.Add(Text:=Format(Plan22.Cells(X, "a").Value, "00"))
        li.ListSubItems.Add Text:=Plan22.Cells(X, "b").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "c").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "d").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "e").Value
 
        li.ListSubItems.Add Text:=Plan22.Cells(X, "f").Value
       
        li.ListSubItems.Add Text:=Plan22.Cells(X, "g").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "h").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "i").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "j").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "k").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "l").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "m").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "n").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "o").Value
        li.ListSubItems.Add Text:=Plan22.Cells(X, "p").Value
     li.ListSubItems.Add Text:=Plan22.Cells(X, "Q").Value
    li.ListSubItems.Add Text:=Plan22.Cells(X, "R").Value
    li.ListSubItems.Add Text:=Format(Plan22.Cells(X, "t").Value, "0.00")
    li.ListSubItems.Add Text:=Format(Plan22.Cells(X, "u").Value, "0.00")
    li.ListSubItems.Add Text:=Format(Plan22.Cells(X, "s").Value, "0.00")


        
        Next
End Sub

Private Sub TextBoxFiltro_Change()

 If TextBoxFiltro = "" Then

   PreencherCabeçalhoLinhas
   formato_islista
  Exit Sub

 If Me.ComboBoxCampos.ListIndex = -1 Then
    
    Me.TextBoxFiltro = ""
  Exit Sub
End If

Dim strObjetoBuscar As String
Dim lngResultado As Long
'Dim lngColumna As Long, lngFila As Long
Dim a As Integer
Dim coluna
Dim li


      
End If
coluna = Me.ComboBoxCampos.ListIndex + 1
lslista.ListItems.Clear
strObjetoBuscar = TextBoxFiltro.Value
If strObjetoBuscar = "" Then GoTo 99
strObjetoBuscar = LCase(strObjetoBuscar)
    For a = 2 To 10000
        lngResultado = InStr(1, Plan22.Cells(a, coluna), strObjetoBuscar, vbTextCompare)
            If lngResultado > 0 Then
 Set li = lslista.ListItems.Add(Text:=Format(Plan22.Range("A" & a).Value, "000"))
               
      
        li.ListSubItems.Add Text:=Plan22.Cells(a, "b").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "c").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "d").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "e").Value
       li.ListSubItems.Add Text:=Plan22.Cells(a, "F").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "g").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "h").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "i").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "j").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "k").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "l").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "m").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "n").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "o").Value
        li.ListSubItems.Add Text:=Plan22.Cells(a, "p").Value
     li.ListSubItems.Add Text:=Plan22.Cells(a, "Q").Value
    li.ListSubItems.Add Text:=Plan22.Cells(a, "R").Value
    
    
     li.ListSubItems.Add Text:=Format(Plan22.Cells(a, "s").Value, "0.00")
li.ListSubItems.Add Text:=Format(Plan22.Cells(a, "t").Value, "0.00")
                 li.ListSubItems.Add Text:=Format(Plan22.Cells(a, "u").Value, "0.00")
            End If
            
    Next a
99:
Me.Label10.Caption = "Total de Dados: " & Format(Me.lslista.ListItems.Count, "000")


Call OcultaColunas


 Call somar
 
End Sub

Private Sub PreencheCampos()
    Dim Ws As Worksheet
    Dim coluna As Integer
    Dim linha As Integer
    Set Ws = ThisWorkbook.Worksheets(NomeDaPlanilha)
    coluna = 1 'de 1 para 2
    linha = LinhaCabecalho
    
    With Ws
        While .Cells(linha, coluna).Value <> Empty
            Me.ComboBoxCampos.AddItem .Cells(linha, coluna)
            coluna = coluna + 1
            If coluna = 5 Then Exit Sub
        Wend
    End With
End Sub

Private Sub PreencheCabecalho(ByRef lista())
    Dim Ws As Worksheet
    Dim coluna As Integer
    Dim linha As Integer
    Set Ws = ThisWorkbook.Worksheets(NomePlanilha)
    coluna = 1 'de 1 p 2
    linha = LinhaCabecalho
    
    With Ws
        While .Cells(linha, coluna).Value <> Empty
            lista(0, coluna - 1) = .Cells(linha, coluna) 'de -1 p -2
            coluna = coluna + 1
        Wend
    End With
 
Postado : 14/04/2015 11:07 am
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Pessoal,

No projeto em questão eu utilizo muito os colchetes para trazer um valor de um célula para o código.

Exemplo:

textbox1 = [a1] + [b1]

Ou seja, não utilizei Dim. Vocês acham que é necessário fazer da seguinte forma:

dim x1
dim x2

X1 = [A1]
X2 = [B1]

textbox1.text = x1 + x2

Eu fiz assim, mas o sistema ficou muito lento!!

 
Postado : 15/04/2015 6:30 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

particularmente não creio que seja por isso que ficou lento, com certeza que deve ter sido pelos eventos que vc colocou, isso é um assassino de desempenho

mas...
eu sempre procuro as maneira mais rapidas e eficientes "nem sempre as corretas(ou que o pessoal fala que é o correto)"

textbox1 = [a1] + [b1]
X1 = [A1]

se vc vai usar essa expressão apenas uma vez

textbox1 = cells(1,1).value2 + cells(1,2).value2

se vc vai usar mais de uma vez, adicione os valores em uma variavel

x=cells(1,1).value2 + cells(1,2).value2

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 15/04/2015 6:40 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Calma Lorenzo, muitas dúvidas em uma...
Primeiro, vc não sabe daonde vem a msg? Isso é grave!

Usa o Ctrl+L *(janela do localizar) para colocar um ponto de interrupção em todas as linhas que contenham MsgBox *(com certeza uma delas está rodando, qdo ela for aparecer, vc saberá)

Em seguida, me explica, vc tá abrindo um Excel pra em seguida fechá-lo umas 3 vezes pra ter certeza q ele fechou, isso faz com que xlApp já está fechado e o erro q vc tem acontece, pois o xlApp deve ter virado Nothing

Qto a seu código gigante no post ali em cima, eu juro pra vc que eu li 5 linhas dele, daí vi o tamanho da barra de rolagem e resolvi não continuar.

O erro do da variávei with não definida se dá quando vc está no código referenciando algo que não está instanciado.
Se a msg está aparecendo, e essa msg não é de erro padrão (Fim Depurar), é customizada, significa que vc a capturou e a imagem q vc enviou é de um msgbox, por isso, procure todos os msgbox e coloque um F9 *(ponto de interrupção) .... ao rodar de novo, replicar o problema, vc vai ver exatamente qual rotina chamou essa msgbox e poderá estudar o que houve ali.

qto à outra dúvida, qto menos vezes vc ler o objeto range, melhor. Usar colchetes ou range("") não faz diferença qto a desempenho. Eu não indico o uso dos colchetes pq vc sempre vai depender da planilha ativa. Se quiser acelerar seu código, é assunto pra outro tópico...

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 15/04/2015 7:29 am
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Fernando,

Parabéns!

Muito didática a sua explicação!

Creio que resolvi o problema, mas não darei esse forum como resolvido ainda, pois utilizarei o sistema por, no mínimo, dois dias e. durante esse tempo, observarei o encerramento do mesmo.

Só mais uma coisa: existe a possibilidade de colocar uma exclamação (f9) em todas msgbox de uma só vez? pergunto isso, pois o meu projeto tem 382 msgbox!

 
Postado : 15/04/2015 1:26 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

não é "exclamação", é "ponto de interrupção"... Não tem como colocar pontos de interrupção assim, mas tem como colocar stop

Faz assim tecle Ctr+U *(janela de substituir texto por texto)

Substitua tudo que for
"Msgbox "
por
"Stop: Msgbox "

*(sem as aspas, coloquei as aspas pra vc ver que vc TEM que escrever o espaço depois do x... Se não fizer isso, vai estragar as msgboxs assim: if msgbox(blablabla) then )]
Quando terminar, volte na janela do substituir e faça o contrário, substitua todos os
"Stop: Msgbox "
por
"Msgbox "

*(tb sem as aspas, claro)

Deve funcionar....

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 15/04/2015 9:24 pm
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

Fernando,

Antes de qualquer coisa, ja tentei substituir as msgbox com espaço, sem espaço, mas o que acontece nada mais é do que um erro de síntese e, por conta disso, a sua sugestão, pelo menos pra mim, não deu certo.

É o seguinte:

Supondo que os erros não são originados por msgbox, ou melhor, supondo que nem ao menos temos ideia das causas possíveis dos erros. Como a gente pode encontrá-los?

O que é feito no projeto para termos a certeza de que erros em tempo de execução e entre outros não ocorrerão?

 
Postado : 16/04/2015 9:19 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

O que se faz em projetos e colocar tratamento adequado de erros em todas as rotinas, esses tratamentos de erro devem todos chamar uma única rotina para tratamento de erro padrão, daí vc colocaria o ponto de interrupção num lugar só.
Assim:
Sub Rotina1()
On Error Goto TratarErro
dim i as integer 'integer tem limite de 32000
'todo seu código
i = 40000 'essa linha gera um erro pq integer vai até 32000, e nao aceita 40000

On error goto 0
Exit Sub
TratarErro:
call Tratamento("Rotina1")
End Sub

Sub Rotina2()
On Error Goto TratarErro
dim i as integer 'integer tem limite de 32000

'todo seu código

i = 40000 'essa linha gera um erro pq integer vai até 32000, e nao aceita 40000

On error goto 0
Exit Sub
TratarErro:
call Tratamento("Rotina2")
End Sub

Sub Tratamento(Rotina as string)
MsgBox "A rotina com erro é " & Rotina, vbokonly
End Sub

No seu caso, como vc não fez isso, vc teria que analisar sue código, saber quais rotinas são chamadas que geram esse erro, e colocar os pontos de interrupção nelas. E então, executar passo a passo até o erro acontecer, brincando com as opção de depuração (F8, F5, Shift+F8, Ctrl+Shift+F8, Ctrl+F9, etc)

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/04/2015 5:59 pm
Lorenzon
 Lorenzon
(@lorenzon)
Posts: 355
Reputable Member
Topic starter
 

não obtive sucesso! =/

 
Postado : 21/04/2015 8:52 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Cara, eu passei algumas formas diferentes, todas boas, e vc não teve sucesso com nenhuma...

Eu desisto..

Sorry,

FF

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 22/04/2015 9:42 am
Página 1 / 2
Forum Jump:
  Tópico Anterior
Próximo Tópico