Página 1 de 1
Mesma macro com resultados diferentes em dois ficheiros
Enviado: 02 Jun 2020 às 10:56
por CSoares
Boa tarde
Tenho dois ficheiros de excel, em que um deles é uma cópia, feita há uns dias.
Não me recordo de ter alterado nada de importante no ficheiro original, desde que fiz a cópia.
Utilizo a mesma macro, em ambos os ficheiros, com resultados diferentes. Ou seja, Estou a criar um ficheiro PDF de uma folha, em que selecciono 4 colunas para exportar.
No ficheiro original, a listagem fica comprimida em apenas 1 folha
No ficheiro copiado, estende a toda a largura da folha e fica em duas folhas, perfeito.
O código do Pagesetup é este:
With Folha2.PageSetup
.CenterHeader = "&BENERSADO - AGENDA DO PESSOAL ACTIVO - &D | &T - Página: &P de &N"
.Zoom = False
.Orientation = xlPortrait
.FitToPagesWide = 2
End With
Não consigo entender, o que poderá estar a causar este problema. Alguém me pode sugerir uma resolução?
Obrigado
Mesma macro com resultados diferentes em dois ficheiros
Enviado: 02 Jun 2020 às 11:03
por CSoares
Desculpem mas é:
.FitToPagesWide = 1
Re: Mesma macro com resultados diferentes em dois ficheiros
Enviado: 02 Jun 2020 às 11:22
por CSoares
No ficheiro original, mesmo não usando nenhuma linha do Pagesetup, ele condensa sempre tudo numa só folha
Re: Mesma macro com resultados diferentes em dois ficheiros
Enviado: 02 Jun 2020 às 11:23
por babdallas
Anexa um exemplo, por favor.
Mesma macro com resultados diferentes em dois ficheiros
Enviado: 02 Jun 2020 às 11:49
por CSoares
São ficheiros de trabalho com dados de clientes, mas poso fazer um ficheiro exemplo com o codigo que estou a utilizar, serve?
Re: Mesma macro com resultados diferentes em dois ficheiros
Enviado: 02 Jun 2020 às 12:07
por babdallas
Sim, serve, desde que represente o problema que você está tendo. No final você deseja que tudo fique em uma página ou deseja que distribua em várias páginas?
Re: Mesma macro com resultados diferentes em dois ficheiros
Enviado: 02 Jun 2020 às 12:33
por CSoares
Pretendo que ele faça uma listagem em PDF, de todas as linhas em que a coluna B tenha as letras NA.
A listagem deverá de ter a coluna Nome, Telefone, Morada, Código Postal e Email
A listagem deverá de ser impressa no menor numero de páginas, mas que utilize, toda a largura da folha. Não me interessa resumir tudo numa só folha, pois torna-se ilegível
Re: Mesma macro com resultados diferentes em dois ficheiros
Enviado: 03 Jun 2020 às 15:51
por babdallas
Veja se atende. Adicionei somente este código ( .FitToPagesTall = VBA.Int((Selection.End(xlDown).Row / 160)) + 1)
Código: Selecionar todosSub PFD()
' Conta número de linhas escritas na coluna C
Dim linhas As Long
linhas = Folha1.Range("C4", Folha1.Range("C4").End(xlDown)).Rows.Count
'Percorre todas as linhas e esconde as que tiverem na coluna B a palavra "NA"
Folha1.Range("A4").AutoFilter Field:=2, Criteria1:="A"
'Esconde as colunas que não desejo gravar no PDF
Folha1.Columns("A:B").Hidden = True
Folha1.Columns("G:R").Hidden = True
Folha1.Columns("T:XX").Hidden = True
'Seleciona as colunas que quero gravar no PDF até á última linha
Folha1.Range("C3:T3").Select
Folha1.Range(Selection, Selection.End(xlDown)).Select
'Parametriza a página a imprimir
Application.PrintCommunication = False
With Folha1.PageSetup
.CenterHeader = "&BENERSADO - AGENDA DO PESSOAL ACTIVO - &D | &T - Página: &P de &N"
.Zoom = False
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = VBA.Int((Selection.End(xlDown).Row / 160)) + 1
End With
Application.PrintCommunication = True
'Define o nome do ficheiro e o seu caminho
localnome = ThisWorkbook.Path & "\AGENDA ENERSADO PDF" ' & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & "_" & Hour(Now) & "h" & Minute(Now) & "m" & Second(Time) & "s"
'Cria o ficheiro PDF
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=localnome, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
'Volta a mostrar todas as colunas e linhas
Folha1.Columns("A:B").Hidden = False
Folha1.Columns("G:R").Hidden = False
Folha1.Columns("T:XX").Hidden = False
If Folha1.FilterMode Then ActiveSheet.ShowAllData
End Sub