Trasformare file excel in pdf e spostarlo in una cartella e rinominare linguetta in base ad una cella

Question

Buonasera a tutti,

avrei una necessità che espongo:

ho un file dove ho un foglio master che uso per fare dei preventivi e che tramite una macro, che ho trovato in un thread ed adattato, mi duplica i fogli e li numera progressivamente. Poi io questi preventivi li devo inviare ai clienti ed li trasformo in pdf tramite

il pulsante " Crea PDF/XPF " presente in Excel. Ora volevo, per velocizzare il lavoro, creare un pulsante che mi trasformasse il foglio in pdf rinominandolo con il nome del cliente e contemporaneamente rinominare la linguetta con il nome dello stesso in maniera che poi i pdf, che dovrebbero andare in una cartella, siano facilmente individuabili. 

La macro che uso per duplicare i fogli è la seguente:

Private Sub CommandButton1_Click()

 ThisWorkbook.Worksheets("Foglio1 (0)").Copy Before:=Sheets(1)

 ActiveSheet.Range("I1") = Sheets.Count - 1

 Worksheets(1).Visible = True

 End Sub

ho provato tramite qualche macro ma non riesce a fare tutte due le funzioni. La macro per trasformare in pdf è la seguente, che originariamente aveva anche la stampa del pdf ma io ho tolto l'istruzione, ma non nomina il pdf con il riferimento al cliente :

Public Sub Macro1()

Dim myPath As String

Dim sh As Worksheet

Application.DisplayAlerts = False

     On Error Resume Next

For Each sh In Sheets

        sh.Name = sh.[G5]

myPath = "C:\Users\Mega\Desktop\Preventivi\Preventivo   "

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

myPath & Range("G5").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _

True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Next

Application.DisplayAlerts = True

End Sub

dove "G5" è il riferimento al cliente.

Potrei avere un suggerimento per capire dove sbaglio e poter realizzare quello di cui avrei bisogno?

Grazie anticipatamente e buona serata.

Mega

Answer 1

Buonasera Norman,

grazie per la risposta e scusa il ritardo della mia ma ero fuori per lavoro.

Io ho provato la macro ma da errore in questo punto

.ExportAsFixedFormat _

                            Type:=xlTypePDF, _

                            Filename:=sPath & aStr & ".pdf", _

                            Quality:=xlQualityStandard, _

                            IncludeDocProperties:=True, _

                            IgnorePrintAreas:=True, _

                            OpenAfterPublish:=False

ho provato delle modifiche ma non va e credo che non faccia quello che io chiedo e mi spiego meglio, scusa colpa mia,

io devo tramite il foglio chiamiamolo master fare dei preventivi, ora per ogni preventivo nuovo devo aggiungere un foglio e numerarlo in successione, la linguetta del foglio deve nominarsi come il nome del cliente e farmi il pdf che io poi conservo in una cartella specifica.

Nel frattempo ho rimediato in questo modo:

utilizzo una userform nella quale ho inserito dei comandi che hanno questa funzione

• uno aggiunge il foglio
• uno lo salva in pdf, rinomina la linguetta del foglio e lo inserisce nella cartella

poi ho aggiunto una combobox che mi funge da elenco perché man mano che aggiungo i fogli perderei del tempo a ritrovarli quando poi per un motivo qualsiasi avrei la necessità di doverci rilavorare sopra.

 

Ora la mia preoccupazione è che il codice che utilizzo non sia veloce e quando i fogli saranno tanti non crei qualche problema.

Ti allego i codici potresti per favore controllarli o vedere qualcosa di più congeniale vista la tua esperienza? Grazie

Option Explicit

 Public WB As Workbook

 Private Sub UserForm_Initialize()

     Dim SH As Worksheet

     Set WB = ThisWorkbook

     With Me

         For Each SH In WB.Worksheets

             Me.ComboBox1.AddItem SH.Name

         Next SH

        .Caption = "Visualizza Foglio"

        .CommandButton1.Caption = "Inserisci Foglio"

        .CommandButton2.Caption = "Salva in cartella"

     End With

 End Sub

 '--------->

 Private Sub CommandButton3_Click()

     Dim SH As Worksheet

     With Me.ComboBox1

         If .ListIndex >= 0 Then

             Set SH = WB.Sheets(.Value)

             With SH

                 .Visible = xlSheetVisible

                 .Select

             End With

         End If

     End With

 End Sub

 '--------->

 Private Sub CommandButton4_Click()

     Unload Me

 End Sub

 '<<========

Private Sub CommandButton1_Click()

 ThisWorkbook.Worksheets("Foglio1 (0)").Copy Before:=Sheets(1)

 ActiveSheet.Range("I1") = Sheets.Count - 1

 Worksheets(1).Visible = True

End Sub

Private Sub CommandButton2_Click()

Dim myPath As String

Dim SH As Worksheet

Application.DisplayAlerts = False

     On Error Resume Next

For Each SH In Sheets

        SH.Name = SH.[G5]

myPath = "C:\Users\Mega\Desktop\Preventivi\Preventivo ABC "

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

myPath & Range("G5").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _

True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Next

Application.DisplayAlerts = True

End Sub

Grazie.

Mega

Answer 2

Ciao Mega,

avrei una necessità che espongo:

ho un file dove ho un foglio master che uso per fare dei preventivi e che tramite una macro, che ho trovato in un thread ed adattato, mi duplica i fogli e li numera progressivamente. Poi io questi preventivi li devo inviare ai clienti ed li trasformo in pdf tramite

il pulsante " Crea PDF/XPF " presente in Excel. Ora volevo, per velocizzare il lavoro, creare un pulsante che mi trasformasse il foglio in pdf rinominandolo con il nome del cliente e contemporaneamente rinominare la linguetta con il nome dello stesso in maniera che poi i pdf, che dovrebbero andare in una cartella, siano facilmente individuabili. 

La macro che uso per duplicare i fogli è la seguente:

Private Sub CommandButton1_Click()

 ThisWorkbook.Worksheets("Foglio1 (0)").Copy Before:=Sheets(1)

 ActiveSheet.Range("I1") = Sheets.Count - 1

 Worksheets(1).Visible = True

 End Sub

ho provato tramite qualche macro ma non riesce a fare tutte due le funzioni. La macro per trasformare in pdf è la seguente, che originariamente aveva anche la stampa del pdf ma io ho tolto l'istruzione, ma non nomina il pdf con il riferimento al cliente :

Public Sub Macro1()

Dim myPath As String

Dim sh As Worksheet

Application.DisplayAlerts = False

     On Error Resume Next

For Each sh In Sheets

        sh.Name = sh.[G5]

myPath = "C:\Users\Mega\Desktop\Preventivi\Preventivo   "

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

myPath & Range("G5").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _

True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Next

Application.DisplayAlerts = True

End Sub

dove "G5" è il riferimento al cliente.

Potrei avere un suggerimento per capire dove sbaglio e poter realizzare quello di cui avrei bisogno?

Prova qualcosa del genere:

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

Option Explicit

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

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim sPath As String

    Dim oName As Name

    Dim sStr As String, aStr As String

    Dim iCtr As Long

    Dim iNumeroFattura As Long

    Const sFoglio As String = "Master"                                '<<=== Modifica

    Const sCellaNomeCliente As String = "G5"                    '<<=== Modifica

    Const sCellaNumeroFattura As String = "I1"                  '<<=== Modifica

    Const iProssimoNumeroFatture = 100                         '<<=== Modifica

    Const sName As String = "NumeroFattura"

    Const sPercorso As String = _

          "C:\Users\Mega\Desktop\Preventivi\Preventivo"      '<<=== Modifica

    sStr = Application.PathSeparator

    If Right(sPercorso, 1) = sStr Then

        sPath = sPercorso

    Else

        sPath = sPercorso & sStr

    End If

    Set WB = ThisWorkbook

    With WB

        On Error Resume Next

        Set oName = .Names(sName)

        On Error GoTo 0

        If Not oName Is Nothing Then

            iNumeroFattura = Evaluate(oName.RefersTo)

        Else

            Set oName = .Names.Add(Name:=sName, _

                                   RefersTo:=iProssimoNumeroFatture)

            iNumeroFattura = iProssimoNumeroFatture

        End If

        For Each SH In WB.Worksheets

            With SH

                If Not .Name = sFoglio And Not .Name Like "Fattura*" Then

                    .Range(sCellaNumeroFattura) = iNumeroFattura

                    aStr = "Fattura_" & iNumeroFattura _

                           & "_" & .Range(sCellaNomeCliente)

                    .ExportAsFixedFormat _

                            Type:=xlTypePDF, _

                            Filename:=sPath & aStr & ".pdf", _

                            Quality:=xlQualityStandard, _

                            IncludeDocProperties:=True, _

                            IgnorePrintAreas:=True, _

                            OpenAfterPublish:=False

                    iNumeroFattura = iNumeroFattura + 1

                    oName.Value = iNumeroFattura

                    .Name = aStr

                End If

            End With

        Next SH

    End With

End Sub

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

===

Regards,

Norman