Salvare file excel in pdf tramite vba

[Espresso90Partecipante Espresso90]

Buongiorno a tutti, 

Ho sviluppato il seguente codice: 

Option Explicit

Function ritorno(dato As String) As String
    Dim caratteri As Variant, strfile As Variant
    Dim strnome As Variant, snome As String
    caratteri = Split(dato, "\")
    strnome = caratteri(UBound(caratteri))
    strfile = Split(strnome, ".")
    snome = strfile(LBound(strfile))

    ritorno = snome
End Function



Sub ProjectBook()

    Dim sh As Worksheet
    Dim tSh As Worksheet
    Dim ws, wb As Workbook
    Dim wk1 As Workbook
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim a As Integer
    Dim x() As Variant
    Dim DisplayStatusBar As Boolean
    Dim NewFileName As String


    Sheets("X").Select


    With Sheets("X")

        .Range(.Cells(4, Columns.Count).End(xlToLeft), .Cells(Rows.Count, 3).End(xlUp)).Select
        Selection.Copy
        Sheets("Foglio1").Activate
        Range("B80").Select
        Selection.PasteSpecial xlPasteFormats
        Selection.PasteSpecial xlPasteValuesAndNumberFormats

        Sheets("Foglio2").Activate
        Range("B35").Select
        Selection.PasteSpecial xlPasteFormats
        Selection.PasteSpecial xlPasteValuesAndNumberFormats
        Sheets("Foglio3").Activate
        Range("B45").Select
        Selection.PasteSpecial xlPasteFormats
        Selection.PasteSpecial xlPasteValuesAndNumberFormats
        Sheets("Foglio4").Activate
        Range("B15").Select
        Selection.PasteSpecial xlPasteFormats
        Selection.PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With
        
    x = Array("Foglio1", "Foglio2", "Foglio3", "Foglio4")
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Sheets
        NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsm"
        a = LBound(x)
        Do
            If x(a) = ws.Name Then
                ws.Copy
                ActiveWorkbook.Sheets(1).Name = ritorno(NewFileName)
                ActiveWorkbook.SaveAs Filename:=NewFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
                ActiveWorkbook.Close SaveChanges:=False
            End If
            a = a + 1
        Loop Until a = UBound(x) + 1
    Next
    
    
    Application.ScreenUpdating = True


End Sub

Con il codice allegato, riesco a cancellare tutti i fogli di un file tranne i fogli: "Foglio1, foglio2, foglio3 e foglio4". E salvo i 4 fogli vengono salvati in altrettanti file excel avanti il nome del foglio.

Adesso vorrei creare 4 file pdf che corrispondano ai 4 file excel che ho ottenuto, che devono essere salvati nella stessa dir dei file excel, aventi lo stesso nome dei file excel.

Qualcuno ha qualche idea/consiglio da darmi?

[albatros54Moderatore albatros54 Karma: 89 pts]

prova ad inserire queste righe di codice

`
ActiveWorkbook.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=NewFileName, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=False`

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

Grazie Albatros funziona!

Ma io vorrei anche potergli dire quando andare a capo, cioè vorrei poter decidere quando spezzare le colonne di excel, non so se sono stato chiaro.

[albatros54Moderatore albatros54 Karma: 89 pts]

Espresso90 wrote:Ma io vorrei anche potergli dire quando andare a capo, cioè vorrei poter decidere quando spezzare le colonne di excel, non so se sono stato chiaro

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Espresso90 wrote:vorrei poter decidere quando spezzare le colonne di excel

Allora devi giocare con le interruzioni di pagina nel foglio Excel e con i margini di pagina.

ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(4.52755905511811)

imposta il margine destro a 11,5 cm. Fai un po' di prove col registratore di macro e poi pulisci la schifezza che ne deriva fin a ottenere un codice accettabile.

[Espresso90Partecipante Espresso90]

Si scusami cerco di spiegarmi meglio, vorrei dare un' interruzione di riga tramite macro, pensi sia possibile?

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Espresso90 wrote:pensi sia possibile?

Certo, lo penso   

Hai provato a registrare una macro che lo faccia, analizzando il codice prodotto e applicandolo al tuo caso specifico?

[Espresso90Partecipante Espresso90]

Son riuscito a trovare la soluzione.

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(intLastRowIndex, strRFQFirtsColumn)

Grazie a tutti per il supporto!

[Autore]

Articoli