Este fórum está sendo desativado

[Wrush]

Boa tarde!!
Preciso criar uma macro para imprimir um tabela até a última linha preenchida? Essa tabela vai crescendo a medida em que o usuário vai inserindo os dados através de um cadastro via formulário.
Criei um botão para impressão e vou adicionar essa macro nesse botão.
Desde já agradeço a atenção!!
Obrigado!!

[gfranco]

Boa tarde.
Vc pode utilizar-se da propriedade address para estabelecer um range variável de impressão. Por exemplo... Se nenhuma coluna vai ficar de fora da impressão vc pode definir uma variável x para estabelecer a área a ser impressa valendo-se da propriedade usedrange assim....
Dim folha as range
Set folha = activesheet.usedrange

Activesheet.pagesetup.printarea = folha.address
Activesheet.printout
Mas existem outras configurações como impressão de títulos,zoom entre outras que vc pode capturar durante a gravação de uma macro enquanto faz o ajuste e depois só usar o exposto acima para variar a área de impressão.
At
gfranco.

[Wrush]

Obrigado gfranco!!
Porém, após eu criar essa macro e inserir o código que você me informou está dando o seguinte erro:
Erro em tempo de execução :1004
O metodo 'PrintCommunication' do objeto 'Application falhou.
Segue Abaixo o código completo:

Dim impressao As Range


Range("A1:J1").Select
Set impressao = Selection.CurrentRegion
ActiveSheet.PageSetup.PrintArea = impressao.Address

Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$2"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = impressao.Address
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"&""DS-Digital,Negrito""&26&K09-022AGENDA TELEFÔNICA - &28GAPLA - LAMINADOR 02"
.RightHeader = "&G"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P de &N"
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = Array(600, 300)
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$2"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = impressao.Address
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"&""DS-Digital,Negrito""&26&K09-022AGENDA TELEFÔNICA - &28GAPLA - LAMINADOR 02"
.RightHeader = "&G"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P de &N"
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = Array(600, 300)
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$2"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = impressao.Address
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"&""DS-Digital,Negrito""&26&K09-022AGENDA TELEFÔNICA - &28GAPLA - LAMINADOR 02"
.RightHeader = "&G"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P de &N"
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = Array(600, 300)
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$2"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = impressao.Address
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"&""DS-Digital,Negrito""&26&K09-022AGENDA TELEFÔNICA - &28GAPLA - LAMINADOR 02"
.RightHeader = "&G"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P de &N"
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = Array(600, 300)
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End Sub

[Wrush]

PS: Após executar macro o Excel trava e fecha a planilha.

[gfranco]

Tive o mesmo problema no trabalho uma vez com esse "Application.PrintCommunication = True/false". Para resolver eu simplesmente apaguei todas as suas ocorrências (de false ou true) e a macro funcionou sem problemas..
At.
gfranco

[Wrush]

Ok gfranco, retirei todas as ocorrências do "Application.PrintCommunication", porém, a macro está muito lenta a processar as instruções, é normal isso? Se não, como fazer para otimizar o processamento dessa macro?

[gfranco]

Eu gosto de colocar as seguintes rotinas antes de imprimir:
sub impressão
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

instruções de impressão....
......
.....
....

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

msgbox "concluído"




end sub

[Wrush]

Obrigado gfranco!! Funcionou, só o processamento da macro ainda está lento, demora aproximadamente uns 40 segundos para terminar o processamento até chegar a visualização de impressão. Mais de qualquer forma, obrigado pela ajuda. A Macro Funcionou. Se souber como melhorar o código, me avise por favor.

[gfranco]

Se vc não fica mudando as configurações de impressão como eu fico, e só o range de impressão que vai mudar vc pode simpresmente escrever:

sub impressão
Range("A1:J1").Select
Set impressao = Selection.CurrentRegion
ActiveSheet.PageSetup.PrintArea = impressao.Address
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

activesheet.printout

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

msgbox "concluído"




end sub