3

com o código abaixo:

    Range("C1:S" & Linha).Select
    ActiveSheet.PageSetup.PrintArea = "$C$1:$S$" & Linha
    Application.ScreenUpdating = True
    Range("C2").Select

consigo imprimir todas as colunas do intervalo col. "c" até col. "S".

Há algum modo de imprimir só as col. "c", "D", "N", "O", "S" ?

Obrg.

Júlio Faria

1 Resposta 1

2

Edit:

Não é possível imprimir na mesma folha uma range não contínua diretamente. Então uma planilha temporária é criada para armazenar os dados em ordem de imprimí-los.

Obs.: Isto vai funcionar somente se todas as colunas tiverem a mesma quantidade de linhas

Código:

Sub ImprimirNaoContinuo()

    Dim rngPrint As Range
    Dim Linha As Long, i As Long
    Dim temp As Worksheet, ws As Worksheet
    Dim Arr() As Variant
    Linha = 15
    Set temp = Sheets.Add
    temp.Name = "Temporário"
    Set ws = Worksheets("Planilha1")
    Set rngPrint = Union(ws.Range("C1:$D" & Linha), ws.Range("$N$1:$O" & Linha), ws.Range("$S$1:$S" & Linha))

    'Função para preencher array com intervalo não contínuo
    'https://stackoverflow.com/a/18994211/7690982
    nr = rngPrint.Areas(1).Rows.Count
    ReDim Arr(1 To nr, 1 To rngPrint.Cells.Count / nr)
    cnum = 0
    For Each ar In rngPrint.Areas
        For Each col In ar.Columns
            cnum = cnum + 1
            rnum = 1
            For Each c In col.Cells
                Arr(rnum, cnum) = c.Value
                rnum = rnum + 1                  'EDIT: added missing line...
            Next c
        Next col
    Next ar


    For k = 1 To cnum
        For i = LBound(Arr) To UBound(Arr)
            temp.Cells(i, k) = Arr(i, k)
        Next i
    Next k

    lngLstRow = ws.UsedRange.Rows.Count
    lngLstCol = ws.UsedRange.Columns.Count

    temp.Range(temp.Cells(1, 1), temp.Cells(lngLstRow, lngLstCol)).PrintPreview
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    temp.Delete
    Application.DisplayAlerts = True
End Sub

Explicação

  • Define a Quantidade de Linhas a serem utilizadas

    Linha = 15
    

Ou pode ser pela última linha preenchida na coluna C:

    Linha = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
  • Cria a planilha temporária e define a planilha em que os dados a serem utilizados estão armazenados:

    Set temp = Sheets.Add
    temp.Name = "Temporário"
    Set ws = Worksheets("Planilha1")
    
  • Define o Range com os dados que serão salvos

    Set rngPrint = Union(ws.Range("C1:$D" & Linha), ws.Range("$N$1:$O" & Linha), ws.Range("$S$1:$S" & Linha))
    
  • Função para ordenar o intervalo não contínuo numa array

    nr = rngPrint.Areas(1).Rows.Count
    ReDim Arr(1 To nr, 1 To rngPrint.Cells.Count / nr)
    cnum = 0
    For Each ar In rngPrint.Areas
        For Each col In ar.Columns
            cnum = cnum + 1
            rnum = 1
            For Each c In col.Cells
                Arr(rnum, cnum) = c.Value
                rnum = rnum + 1                  'EDIT: added missing line...
            Next c
        Next col
    Next ar
    
  • Inserir os valores da Array na planilha temporária

    For k = 1 To cnum
        For i = LBound(Arr) To UBound(Arr)
            temp.Cells(i, k) = Arr(i, k)
        Next i
    Next k
    
  • Abrir a janela de Visualização de impressão com o range utilizado

    temp.Range(temp.Cells(1, 1), temp.Cells(lngLstRow, lngLstCol)).PrintPreview
    
  • Deletar a planilha Temporária

    Application.DisplayAlerts = False
    temp.Delete
    Application.DisplayAlerts = True
    

Edit2:

Para manter a formatação, cada coluna utilizada será copiada e depois colada na planilha temporária, mantendo assim, a formatação

Código

Sub ImprimirNaoContinuo2()

    Dim rngPrint As Range
    Dim Linha As Long, i As Long
    Dim temp As Worksheet, ws As Worksheet
    Dim Arr() As Variant

    Set temp = Sheets.Add
    temp.Name = "Temporário"
    Set ws = Worksheets("Planilha1")
    Linha = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    Set rngPrint = Union(ws.Range("C1:$D" & Linha), ws.Range("$N$1:$O" & Linha), ws.Range("$S$1:$S" & Linha))

    For Each coluna In rngPrint.Columns
        i = i + 1
        coluna.Copy temp.Cells(1, i)
    Next coluna

    lngLstRow = temp.UsedRange.Rows.Count
    lngLstCol = temp.UsedRange.Columns.Count

    temp.Range(temp.Cells(1, 1), temp.Cells(lngLstRow, lngLstCol)).PrintPreview
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    temp.Delete
    Application.DisplayAlerts = True
End Sub

Explicação

    For Each coluna In rngPrint.Columns
        i = i + 1
        coluna.Copy temp.Cells(1, i)
    Next coluna

Cada coluna no intervalo não contínuo é copiado e colado em ordem na nova planilha temporária. As outras partes do código já foram explicadas anteriormente.

Resposta Original

Você pode definir um intervalo não contínuo deste modo:

"$C$1:$D" & Linha & ", $N$1:$O" & Linha & ", $S$1:$S" & Linha

Em que, cada intervalo pode ser separado por uma vígula ,

Assim o código ficaria:

ActiveSheet.PageSetup.PrintArea = "$C$1:$D" & Linha & ", $N$1:$O" & Linha & ", $S$1:$S" & Linha
Application.ScreenUpdating = True
Range("C2").Select

Obs.: Tente evitar o uso de .Select, ActiveCell, ActiveSheet, etc. Pois podem ocorrer erros. No SOEN há um tópico com alguns exemplos de como evitá-los neste link: How to avoid using Select in Excel VBA

6
  • Já tentei com o seu código, mas agora ao imprimir, aparecem as colunas C e D numa folha, e as restantes noutra folha. Para imprimir a tabela, bast a 1 folha!! 31/01/2018 às 12:05
  • Mais uma vez obrg. Não é a solução ideal porque perde a formatação ao imprimir. vou tentar melhorar. 31/01/2018 às 18:09
  • 1
    Outra maneira é copiar e colar com paste format, cada coluna em uma coluna numa nova planilha temporária. Porém, dependendo do tamanho da tabela, pode demorar 31/01/2018 às 19:12
  • Como é que eu poderia transferir as colunas alternadas a partir de uma listview para impressão? Já consigo imprimir colunas contínuas, mas não estou a conseguir copiar e colar para a planilha temporária... 1/02/2018 às 21:41
  • 1
    @JúlioFaria Veja o Edit2 2/02/2018 às 18:37

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .