Convertire in Pdf solo la parte visibile

Question

Convertire in Pdf solo la parte visibile

Anonimo

Ciao a tutti,

Mi affido al vostro aiuto per avere la possibilità di convertire in Pdf solo la parte visibile del foglio. Dico questo perché mediante il codice scritto da Norman in questo theread selezionando i valori delle celle B3 e G3 nascondo le righe che non mi servono. Nel momento che vado a convertire in Pdf quello che compare nel Pdf non è come lo visualizzo sul foglio excel. In base ai valori che scelgo ad esempio se nell'ordine dei nomi della cella B3 scelgo il terzo, vedo le prime 4 righe e poi tutto bianco fino a scorrere dove vengono riportati i valori selezionati. Potete aiutarmi a fare in modo che il tutto venga accorpato e quindi mi converte in Pdf solo la parte visibile escludendo il bianco delle righe nascoste? Grazie

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Geacs,

Mi affido al vostro aiuto per avere la possibilità di convertire in Pdf solo la parte visibile del foglio. Dico questo perché mediante il codice scritto da Norman in questo theread selezionando i valori delle celle B3 e G3 nascondo le righe che non mi servono. Nel momento che vado a convertire in Pdf quello che compare nel Pdf non è come lo visualizzo sul foglio excel. In base ai valori che scelgo ad esempio se nell'ordine dei nomi della cella B3 scelgo il terzo, vedo le prime 4 righe e poi tutto bianco fino a scorrere dove vengono riportati i valori selezionati. Potete aiutarmi a fare in modo che il tutto venga accorpato e quindi mi converte in Pdf solo la parte visibile escludendo il bianco delle righe nascoste?

In un modulo di codice del famoso file, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

Dim WB As Workbook

Dim srcSH As Worksheet, pdfSH As Worksheet

Dim rngDati As Range, rngVisibile As Range, rngDest As Range

Dim LRow As Long

Dim sNomePdf As String

Dim sResponsabile As String, sPeriodo As String

Dim CalcMode As Long

On Error GoTo XIT

With Application

CalcMode = .Calculation

.Calculation = xlCalculationManual

.ScreenUpdating = False

.EnableEvents = False

.DisplayAlerts = False

End With

Set WB = ThisWorkbook

With WB

Set srcSH = WB.Sheets(sFoglio)

Set pdfSH = .Sheets.Add(Before:=.Sheets(1))

End With

With srcSH

LRow = LastRow(srcSH, .Columns("A:A"))

Set rngDati = .Range("A1:H" & LRow)

sResponsabile = .Range(sCellaConvalidaResponsabile).Value

sPeriodo = .Range(sCellaConvalidaPeriodo).Value

End With

Set rngDest = pdfSH.Range("A1")

Set rngVisibile = rngDati.SpecialCells(xlCellTypeVisible)

rngVisibile.Copy

With rngDest

.PasteSpecial Paste:=xlPasteColumnWidths

.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

End With

sNomePdf = sResponsabile & "(" & sPeriodo & ")" _

& " " & Format(Now, "d-mm-yyyy hh-mm") & ").pdf"

With pdfSH

With .PageSetup

.Zoom = False

.PrintGridlines = False

.Orientation = xlLandscape

.FitToPagesWide = 1

.FitToPagesTall = False

End With

.ExportAsFixedFormat _

Type:=xlTypePDF, _

Filename:=sNomePdf, _

Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=True, _

OpenAfterPublish:=True

.Delete

End With

XIT:

With Application

.DisplayAlerts = True

.Calculation = CalcMode

.EnableEvents = True

.ScreenUpdating = True

End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, _

Optional minRow As Long = 1, _

Optional strPassword As String)

Dim bProtected As Boolean

With SH

If Rng Is Nothing Then

Set Rng = .Cells

End If

bProtected = .ProtectContents = True

If bProtected Then

.Unprotect Password:=sPassWord

End If

End With

On Error Resume Next

LastRow = Rng.Find(What:="*", _

after:=Rng.Cells(1), _

Lookat:=xlPart, _

LookIn:=xlFormulas, _

SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious, _

MatchCase:=False).Row

On Error GoTo 0

If LastRow < minRow Then

LastRow = minRow

End If

If bProtected Then

SH.Protect Password:=sPassWord, _

UserInterfaceOnly:=True

End If

End Function

'<<=========

Nota che tu non hai bisogno dela funzione LastRow qui sopra perchè questa funzione si trova già nel tuo progetto.

Potresti scaricare il mio file di prova Geacs20170919.xlsm

===

Regards,

Norman

0 commenti

3 risposte aggiuntive

Answer 1

Ciao Geacs,

Dato la disposizione dei tuoi dati, vorrei suggerire una picola modifica al codice. Quindi, prova a sostituire:

With pdfSH

With .PageSetup

.Zoom = False

.PrintGridlines = False

.Orientation = xlLandscape

.FitToPagesWide = 1

.FitToPagesTall = False

End With

con:

With pdfSH

With .PageSetup

.Zoom = False

.PrintGridlines = False

.Orientation = xlPortrait

.FitToPagesWide = 1

.FitToPagesTall = False

End With

===

Regards,

Norman

Answer 2

Ciao Geacs,

Ho appena finito di provare e riprovare il codice ed esaudisce in modo perfetto la mia domanda e richiesta. Mi hai fatto un altro grandissimo regalone. Ho provato a trovare qualcosa che faceva quello che hai preparato tu ma non ho trovato niente. Grazie ancora.

Mi fa molto piacere che tu abbia risolto il problema e ti ringrazio per il cortese riscontro.

Alla prossima.

===

Regards,

Norman

Answer 3

Anonimo

Ciao Norman,

Ho appena finito di provare e riprovare il codice ed esaudisce in modo perfetto la mia domanda e richiesta. Mi hai fatto un altro grandissimo regalone. Ho provato a trovare qualcosa che faceva quello che hai preparato tu ma non ho trovato niente. Grazie ancora.

0 commenti