none
VBA EXCEL, COMO LIMPAR FORMULARIO ANTES DA PROXIMA IMPRESSAO? RRS feed

  • Pergunta

  • Pessoal esta macro está funcionando. Porém, na hora de imprimir a última folha caso tenha menos de 10 ela preenche com os que tem e deixa a sujeira dos dados anteriores.

    Alguém pode corrigir? 

    Sub pFopag()
        Dim lngFill As Long
        Dim lngRow As Long
        Dim col As Long
        Dim lin As Long
        Dim rng As Excel.Range
        Dim strAddress As String
        Dim wksDados As Excel.Worksheet
        Dim wksFopag As Excel.Worksheet

        Set wksDados = ThisWorkbook.Worksheets("DADOS")
        Set wksFopag = ThisWorkbook.Worksheets("FOPAG")

        Application.ScreenUpdating = False
        Sheets("FOPAG").Visible = True

    '   Classificar coluna Filial em ordem ascendente
        With ActiveWorkbook.Worksheets("DADOS").ListObjects("TAB").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    '   Filtrar valores positivos da coluna 10
        wksDados.ListObjects("TAB").Range.AutoFilter Field:=10, Criteria1:="<>0" _
            , Operator:=xlAnd

    '   Preencher com zeros as células em branco - colunas 6 a 10
        lngRow = wksDados.Cells(wksDados.Rows.Count, "C").End(xlUp).Row - 1
            col = 6
        While col < 11
            lin = 1
            While lin < lngRow
                lin = lin + 1
                If Cells(lin, col) = "" Then
                   Cells(lin, col) = "0"
                End If
            Wend
            col = col + 1
        Wend

    '   Preencher o formulário FOPAG (10 quadros)
        For lngRow = 2 To wksDados.Cells(wksDados.Rows.Count, "C").End(xlUp).Row - 1
            If wksDados.Rows(lngRow).Hidden = False Then
                Select Case lngFill Mod 10
                    Case 0: strAddress = "A1"
                    Case 1: strAddress = "A14"
                    Case 2: strAddress = "A27"
                    Case 3: strAddress = "A40"
                    Case 4: strAddress = "A53"
                    Case 5: strAddress = "I1"
                    Case 6: strAddress = "I14"
                    Case 7: strAddress = "I27"
                    Case 8: strAddress = "I40"
                    Case 9: strAddress = "I53"
                End Select

        Set rng = wksFopag.Range(strAddress)
          rng.Range("C2").Value2 = wksDados.Cells(lngRow, "E").Value2
          rng.Range("B3").Value2 = wksDados.Cells(lngRow, "B").Value2 _
          & " - " & wksDados.Cells(lngRow, "C").Value2
          rng.Range("E4").Value2 = wksDados.Cells(lngRow, "F").Value2
          rng.Range("E5").Value2 = wksDados.Cells(lngRow, "G").Value2
          rng.Range("E6").Value2 = wksDados.Cells(lngRow, "H").Value2
          rng.Range("E7").Value2 = wksDados.Cells(lngRow, "I").Value2
          rng.Range("E11").Value2 = wksDados.Cells(lngRow, "D").Value2

            If lngFill Mod 10 = 9 Then wksFopag.PrintOut
                lngFill = lngFill + 1
            End If
        Next lngRow

      If lngFill Mod 10 <> 0 Then wksFopag.PrintOut


    'Ir para o início da planilha DADOS
        wksDados.Select
        Range("B1").Select

    '   Todas as linhas da lista filtrada no momento torna visível.Se o AutoFiltro estiver em uso, esse método mudará as setas para "Tudo"
        ActiveSheet.ShowAllData

    '   Classificar coluna NOME em ordem ascendente
        Range("C2").Select
        With ActiveWorkbook.Worksheets("DADOS").ListObjects("TAB").Sort
            .SortFields.Clear
            .SortFields.Add Key _
            :=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With


        Sheets("FOPAG").Visible = False
        Application.ScreenUpdating = True
    End Sub

                                            
    Planilha FOPAG => BAIXE AQUI
    • Editado JairNikit quinta-feira, 1 de maio de 2014 03:01
    domingo, 27 de abril de 2014 23:44

Respostas

  • Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum. Uma janela aparecerá onde você deverá colar seu código cru na caixa de texto à esquerda. Então, selecione a opção Vb.Net na caixa de combinação que você verá em cima à esquerda e depois clique no botão Inserir.

    ---

    Para apagar o "lixo", tente colocar o código abaixo logo após o término do laço:

      For lngGarb = lngFill To 9
        Select Case lngGarb Mod 10
          Case 0: strAddress = "A1"
          Case 1: strAddress = "A14"
          Case 2: strAddress = "A27"
          Case 3: strAddress = "A40"
          Case 4: strAddress = "A53"
          Case 5: strAddress = "I1"
          Case 6: strAddress = "I14"
          Case 7: strAddress = "I27"
          Case 8: strAddress = "I40"
          Case 9: strAddress = "I53"
        End Select
    
        Set rng = wksFopag.Range(strAddress)
        rng.Range("C2").ClearContents
        rng.Range("B3").ClearContents
        rng.Range("E4").ClearContents
        rng.Range("E5").ClearContents
        rng.Range("E6").ClearContents
        rng.Range("E7").ClearContents
        rng.Range("E11").ClearContents
      Next lngGarb


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 28 de abril de 2014 23:46
    Moderador

Todas as Respostas

  • Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum. Uma janela aparecerá onde você deverá colar seu código cru na caixa de texto à esquerda. Então, selecione a opção Vb.Net na caixa de combinação que você verá em cima à esquerda e depois clique no botão Inserir.

    ---

    Para apagar o "lixo", tente colocar o código abaixo logo após o término do laço:

      For lngGarb = lngFill To 9
        Select Case lngGarb Mod 10
          Case 0: strAddress = "A1"
          Case 1: strAddress = "A14"
          Case 2: strAddress = "A27"
          Case 3: strAddress = "A40"
          Case 4: strAddress = "A53"
          Case 5: strAddress = "I1"
          Case 6: strAddress = "I14"
          Case 7: strAddress = "I27"
          Case 8: strAddress = "I40"
          Case 9: strAddress = "I53"
        End Select
    
        Set rng = wksFopag.Range(strAddress)
        rng.Range("C2").ClearContents
        rng.Range("B3").ClearContents
        rng.Range("E4").ClearContents
        rng.Range("E5").ClearContents
        rng.Range("E6").ClearContents
        rng.Range("E7").ClearContents
        rng.Range("E11").ClearContents
      Next lngGarb


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 28 de abril de 2014 23:46
    Moderador
  • Pow Benzadeus, já levei dois "puxões de orelha", desculpe não saber utilizar a ferramenta do fórum. 

    Em relação ao código não sei bem onde termina o laço, mas coloquei esse código que você me passou em várias posições e não surtiram efeito. Poderia me apontar o dedo? Obrigado.

    terça-feira, 29 de abril de 2014 00:18
  • Experimente colocar após a linha

    Next lngRow


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 29 de abril de 2014 21:39
    Moderador
  • Qual linha? 

    Poderia me informar?

    Muito obrigado.

    terça-feira, 29 de abril de 2014 22:28
  • Após "Next lngRow", como eu disse.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 29 de abril de 2014 22:53
    Moderador
  • Após "Next lngRow", como eu disse.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    Sub pFopag()
        Dim lngFill As Long
        Dim lngRow As Long
        Dim col As Long
        Dim lin As Long
        Dim rng As Excel.Range
        Dim strAddress As String
        Dim wksDados As Excel.Worksheet
        Dim wksFopag As Excel.Worksheet
      
        Set wksDados = ThisWorkbook.Worksheets("DADOS")
        Set wksFopag = ThisWorkbook.Worksheets("FOPAG")
      
        Application.ScreenUpdating = False
        Sheets("FOPAG").Visible = True
    
    '   Classificar coluna Filial em ordem ascendente
        With ActiveWorkbook.Worksheets("DADOS").ListObjects("TAB").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
          
    '   Filtrar valores diferentes de zero na coluna 10
        wksDados.ListObjects("TAB").Range.AutoFilter Field:=10, Criteria1:="<>0" _
            , Operator:=xlAnd
    
    '   Preencher com zeros as células em branco - colunas 6 a 10
        lngRow = wksDados.Cells(wksDados.Rows.Count, "C").End(xlUp).Row - 1
            col = 6
        While col < 11
            lin = 1
            While lin < lngRow
                lin = lin + 1
                If Cells(lin, col) = "" Then
                   Cells(lin, col) = "0"
                End If
            Wend
            col = col + 1
        Wend
        
    '   Preencher o formulário FOPAG (10 quadros)
        For lngRow = 2 To wksDados.Cells(wksDados.Rows.Count, "C").End(xlUp).Row - 1
            If wksDados.Rows(lngRow).Hidden = False Then
                Select Case lngFill Mod 10
                    Case 0: strAddress = "A1"
                    Case 1: strAddress = "A14"
                    Case 2: strAddress = "A27"
                    Case 3: strAddress = "A40"
                    Case 4: strAddress = "A53"
                    Case 5: strAddress = "I1"
                    Case 6: strAddress = "I14"
                    Case 7: strAddress = "I27"
                    Case 8: strAddress = "I40"
                    Case 9: strAddress = "I53"
                End Select
          
        Set rng = wksFopag.Range(strAddress)
          rng.Range("C2").Value2 = wksDados.Cells(lngRow, "E").Value2
          rng.Range("B3").Value2 = wksDados.Cells(lngRow, "B").Value2 _
          & " - " & wksDados.Cells(lngRow, "C").Value2
          rng.Range("E4").Value2 = wksDados.Cells(lngRow, "F").Value2
          rng.Range("E5").Value2 = wksDados.Cells(lngRow, "G").Value2
          rng.Range("E6").Value2 = wksDados.Cells(lngRow, "H").Value2
          rng.Range("E7").Value2 = wksDados.Cells(lngRow, "I").Value2
          rng.Range("E11").Value2 = wksDados.Cells(lngRow, "D").Value2
          
            If lngFill Mod 10 = 9 Then wksFopag.PrintOut
                lngFill = lngFill + 1
            End If
        Next lngRow
        
    ' Limpar dados do formulário FOPAG
      For lngGarb = lngFill To 9
        Select Case lngGarb Mod 10
          Case 0: strAddress = "A1"
          Case 1: strAddress = "A14"
          Case 2: strAddress = "A27"
          Case 3: strAddress = "A40"
          Case 4: strAddress = "A53"
          Case 5: strAddress = "I1"
          Case 6: strAddress = "I14"
          Case 7: strAddress = "I27"
          Case 8: strAddress = "I40"
          Case 9: strAddress = "I53"
        End Select
    
        Set rng = wksFopag.Range(strAddress)
        rng.Range("C2").ClearContents
        rng.Range("B3").ClearContents
        rng.Range("E4").ClearContents
        rng.Range("E5").ClearContents
        rng.Range("E6").ClearContents
        rng.Range("E7").ClearContents
        rng.Range("E11").ClearContents
      Next lngGarb
      
      If lngFill Mod 10 <> 0 Then wksFopag.PrintOut
    
    
    'Ir para o início da planilha DADOS
        wksDados.Select
        Range("B1").Select
    
    '   Todas as linhas da lista filtrada no momento torna visível.Se o AutoFiltro estiver em uso, esse método mudará as setas para "Tudo"
        ActiveSheet.ShowAllData
        
    '   Classificar coluna NOME em ordem ascendente
        Range("C2").Select
        With ActiveWorkbook.Worksheets("DADOS").ListObjects("TAB").Sort
            .SortFields.Clear
            .SortFields.Add Key _
            :=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        
        Sheets("FOPAG").Visible = False
        Application.ScreenUpdating = True
    End Sub
    Benzadeus, coloquei onde você indicou, mas não alterou nada. 

    Será que tem como resolver essa?
    • Editado JairNikit quinta-feira, 1 de maio de 2014 02:54
    terça-feira, 29 de abril de 2014 23:36