Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Deixar formulário V...
 
Notifications
Clear all

Deixar formulário VBA mais rápido

 
2024 - VBA & Macros
Post Recente por klarc28 7 anos atrás
11 Posts
3 Usuários
0 Reactions
2,081 Visualizações
RSS
 Geise
(@geise)
Posts: 40
Eminent Member
Topic starter
 

Boa tarde

Gostaria de saber se tem como deixar este formulário mais rápido.

 
Postado : 19/01/2018 3:34 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

O que vc quer dizer com mais rapido?

Eu abri o formulario e pra mim esta bem rapido.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 19/01/2018 5:43 pm
 Geise
(@geise)
Posts: 40
Eminent Member
Topic starter
 

quero que fique mais rápido ainda

 
Postado : 19/01/2018 8:16 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Não creio que seja possivel ou que faça grande diferença, mas enfim vamos aguardar alguém se manifestar.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 19/01/2018 8:38 pm
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Select e Activate deixam mais lento.

 
Postado : 20/01/2018 5:12 am
 Geise
(@geise)
Posts: 40
Eminent Member
Topic starter
 

mas qual código posso usar para fazer a substituição que faça a mesma finalidade

 
Postado : 21/01/2018 7:27 pm
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 
Option Explicit

Public vMes As String
Public somaFarmaciaMes, somaFarmaciaAno As Double
Public somaAçougueMes, somaAçougueAno As Double
Public somaLeiteMes, somaLeiteAno As Double
Public somaAguaLuzMes, somaAguaLuzAno As Double
Public somaSalariosMes, somaSalariosAno As Double
Public somaTekaMes, somaTekaAno As Double
Public somaCasaMes, somaCasaAno As Double
Public somaPgtoMes, somaPgtoAno As Double
Public somaSaqueMes, somaSaqueAno As Double
Public c as Long
Public a as Long

Function retornaMesEAno(ByVal Mes As String, ByVal Ano As Integer)
    somaFarmaciaMes = "0"
    somaFarmaciaAno = "0"
    somaAçougueMes = "0"
    somaAçougueAno = "0"
    somaLeiteMes = "0"
    somaLeiteAno = "0"
    somaAguaLuzMes = "0"
    somaAguaLuzAno = "0"
    somaSalariosMes = "0"
    somaSalariosAno = "0"
    somaTekaMes = "0"
    somaTekaAno = "0"
    somaCasaMes = "0"
    somaCasaAno = "0"
    somaPgtoMes = "0"
    somaPgtoAno = "0"
    somaSaqueMes = "0"
    somaSaqueAno = "0"
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Sheets("FARMACIA")
      '  .Activate
        For a = 2 To .UsedRange.Rows.Count
          '  .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaFarmaciaMes = somaFarmaciaMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaFarmaciaAno = somafarmaciAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    With ThisWorkbook.Sheets("AÇOUGUE")
       ' .Activate
        For a = 2 To .UsedRange.Rows.Count
         '   .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaAçougueMes = somaAçougueMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaAçougueAno = somaAçougueAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    With ThisWorkbook.Sheets("LEITE")
        '.Activate
        For a = 2 To .UsedRange.Rows.Count
           ' .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaLeiteMes = somaLeiteMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaLeiteAno = somaLeiteAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    With ThisWorkbook.Sheets("AGUA E LUZ")
       ' .Activate
        For a = 2 To .UsedRange.Rows.Count
        '    .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaAguaLuzMes = somaAguaLuzMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaAguaLuzAno = somaAguaLuzAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    With ThisWorkbook.Sheets("SALARIOS")
       ' .Activate
        For a = 2 To .UsedRange.Rows.Count
        '    .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaSalariosMes = somaSalariosMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaSalariosAno = somaSalariosAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    With ThisWorkbook.Sheets("TEKA")
     '   .Activate
        For a = 2 To .UsedRange.Rows.Count
        '    .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaTekaMes = somaTekaMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaTekaAno = somaTekaAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    With ThisWorkbook.Sheets("PRESTAÇÃO DA CASA")
       ' .Activate
        For a = 2 To .UsedRange.Rows.Count
        '    .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaCasaMes = somaCasaMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaCasaAno = somaCasaAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    With ThisWorkbook.Sheets("PGTO OBRIGATORIO")
       ' .Activate
        For a = 2 To .UsedRange.Rows.Count
        '    .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaPgtoMes = somaPgtoMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaPgtoAno = somaPgtoAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
     With ThisWorkbook.Sheets("SAQUE")
       ' .Activate
        For a = 2 To .UsedRange.Rows.Count
         '   .cells(a, "A").Select
            If .Cells(a, "A") <> "" Then
                If Mid(.Cells(a, "A"), 4, 2) = Mes Then
                    somaSaqueMes = somaSaqueMes + CDbl(Format(.Cells(a, "B"), "currency"))
                        If Mid(.Cells(a, "A"), 7, 4) = Ano Then
                            somaSaqueAno = somaSaqueAno + CDbl(Format(.Cells(a, "B"), "currency"))
                        End If
                End If
            End If
        Next
    End With
    
    ThisWorkbook.Sheets("Menu").Activate
    Application.ScreenUpdating = True
End Function

Function geraRelatorioObrigatorioMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("PGTO OBRIGATORIO")
              '  .Activate
                For c = 2 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioCasaMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 200, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("PRESTAÇÃO DA CASA")
               ' .Activate
                For c = 4 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioTekaMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("TEKA")
               ' .Activate
                For c = 4 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioSalarioMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("SALARIOS")
               ' .Activate
                For c = 4 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioAguaLuzMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("AGUA E LUZ")
             '   .Activate
                For c = 4 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioLeiteMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("LEITE")
              '  .Activate
                For c = 4 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioAçougueMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("AÇOUGUE")
                '.Activate
                For c = 4 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioFarmaciaMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("FARMACIA")
               ' .Activate
                For c = 4 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function

Function geraRelatorioSaqueMensal(ByVal rMes As String, ByVal rAno As String)
    With frmRelatorio
        .ListView1.ListItems.Clear
        .ListView1.ColumnHeaders.Clear
        .ListView1.ColumnHeaders.Add , , "Id", 30
        .ListView1.ColumnHeaders.Add , , "Data", 60
        .ListView1.ColumnHeaders.Add , , "Valor", 60, 2
        .ListView1.ColumnHeaders.Add , , "Descrição", 260, 2
        .ListView1.AllowColumnReorder = False
        .ListView1.FullRowSelect = True
        .ListView1.Gridlines = True
        .ListView1.LabelEdit = lvwManual
        .ListView1.LabelWrap = False
        .ListView1.View = lvwReport
            
            Dim lst
            Dim a, b As Integer
            
            Application.ScreenUpdating = False
            
            With ThisWorkbook.Sheets("SAQUE")
               ' .Activate
                For c = 2 To .UsedRange.Rows.Count
                    If Mid(.Cells(c, "A"), 4, 10) = CStr(rMes & "/" & rAno) Then
                        Set lst = frmRelatorio.ListView1.ListItems.Add(, , frmRelatorio.ListView1.ListItems.Count + 1)
                        a = frmRelatorio.ListView1.ListItems.Count
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "A")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "B")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , .Cells(c, "C")
                        frmRelatorio.ListView1.ListItems(a).ListSubItems.Add , , c
                        
                    End If
                Next
            End With
            
            With ThisWorkbook.Sheets("Menu")
                .Activate
            End With
            
            Application.ScreenUpdating = True
    End With
End Function
 
Postado : 21/01/2018 7:32 pm
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

mas qual código posso usar para fazer a substituição que faça a mesma finalidade

Quando fizer uma pergunta, use ponto de interrogação.

 
Postado : 21/01/2018 7:47 pm
 Geise
(@geise)
Posts: 40
Eminent Member
Topic starter
 

coloquei este código e ao tentar executar aparece erro a variável não declarada "C"

 
Postado : 22/01/2018 2:15 pm
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Apague a linha Option Explicit

Ou declare as variáveis:

Public c as Long
Public a as Long

 
Postado : 22/01/2018 2:16 pm
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

https://youtu.be/FAOQfKL5pXc

 
Postado : 22/01/2018 2:45 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico