Note: The other languages of the website are Google-translated. Back to English
English English

Come salvare un foglio di lavoro come file PDF e inviarlo tramite posta elettronica come allegato tramite Outlook?

In alcuni casi, potrebbe essere necessario inviare un foglio di lavoro come file PDF tramite Outlook. Di solito, devi salvare manualmente il foglio di lavoro come file PDF, quindi creare una nuova e-mail con questo file PDF come allegato in Outlook e infine inviarlo. È dispendioso in termini di tempo per ottenerlo manualmente passo dopo passo. In questo articolo, ti mostreremo come salvare rapidamente un foglio di lavoro come file PDF e inviarlo automaticamente come allegato tramite Outlook in Excel.

Salva un foglio di lavoro come file PDF e invialo tramite e-mail come allegato con codice VBA


Salva un foglio di lavoro come file PDF e invialo tramite e-mail come allegato con codice VBA


È possibile eseguire il codice VBA di seguito per salvare automaticamente il foglio di lavoro attivo come file PDF e quindi inviarlo tramite posta elettronica come allegato tramite Outlook. Si prega di fare quanto segue.

1. Aprire il foglio di lavoro che si salverà come PDF e inviare, quindi premere il tasto altro + F11 tasti contemporaneamente per aprire il file Microsoft Visual Basic, Applications Edition finestra.

2. Nel Microsoft Visual Basic, Applications Edition finestra, fare clic inserire > Modulo. Quindi copia e incolla il codice VBA sottostante nel file Codice finestra. Vedi screenshot:

Codice VBA: salva un foglio di lavoro come file PDF e invialo via email come allegato

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file 
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email 
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

3. premi il F5 chiave per eseguire il codice. Nel Scopri la nostra gamma finestra di dialogo, selezionare una cartella per salvare questo file PDF, quindi fare clic su OK pulsante.

Note:

1. Ora il foglio di lavoro attivo viene salvato come file PDF. E il file PDF è denominato con il nome del foglio di lavoro.
2. Se il foglio di lavoro attivo è vuoto, verrà visualizzata una finestra di dialogo come mostrato nell'immagine sottostante dopo aver fatto clic su OK pulsante.

4. Ora viene creata una nuova email di Outlook e puoi vedere che il file PDF è elencato come allegato nel campo Allegati. Vedi screenshot:

5. Componi questa email e poi inviala.
6. Questo codice è disponibile solo quando si utilizza Outlook come programma di posta.

Salva facilmente un foglio di lavoro o più fogli di lavoro come file PDF separati contemporaneamente:

Lo Cartella di lavoro divisa utilità di Kutools for Excel può aiutarti a salvare facilmente un foglio di lavoro o più fogli di lavoro come file PDF separati contemporaneamente come mostrato nella demo di seguito. Scaricalo e provalo subito! (30 giorni di percorso gratuito)


Articoli correlati:


I migliori strumenti per la produttività in ufficio

Kutools per Excel risolve la maggior parte dei tuoi problemi e aumenta la tua produttività dell'80%

  • Riutilizzo: Inserisci rapidamente formule complesse, grafici e tutto ciò che hai usato prima; Crittografa celle con password; Crea mailing list e invia email ...
  • Bar Super Formula (modifica facilmente più righe di testo e formula); Layout di lettura (leggi e modifica facilmente un gran numero di celle); Incolla su intervallo filtrato...
  • Unisci celle / righe / colonne senza perdere dati; Contenuto delle celle divise; Combina righe / colonne duplicate... Impedisci celle duplicate; Confronta intervalli...
  • Seleziona Duplica o Unico Righe; Seleziona Righe vuote (tutte le celle sono vuote); Super Find e Fuzzy Find in molte cartelle di lavoro; Selezione casuale ...
  • Copia esatta Più celle senza modificare il riferimento della formula; Riferimenti di creazione automatica a più fogli; Inserisci punti elenco, Caselle di controllo e altro ...
  • Estrai testo, Aggiungi testo, Rimuovi per posizione, Rimuovi spazio; Creare e stampare totali parziali di paging; Converti contenuto e commenti tra celle...
  • Super filtro (salva e applica schemi di filtri ad altri fogli); Ordinamento avanzato per mese / settimana / giorno, frequenza e altro; Filtro speciale in grassetto, corsivo ...
  • Combina cartelle di lavoro e fogli di lavoro; Unisci tabelle in base a colonne chiave; Suddividi i dati in più fogli; Conversione in batch xls, xlsx e PDF...
  • Più di 300 potenti funzionalità. Supporta Office / Excel 2007-2019 e 365. Supporta tutte le lingue. Facile distribuzione nella tua azienda o organizzazione. Funzionalità complete Prova gratuita di 30 giorni. Garanzia di rimborso di 60 giorni.
scheda kte 201905

Scheda Office porta l'interfaccia a schede a Office e semplifica notevolmente il lavoro

  • Abilita la modifica e la lettura a schede in Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Apri e crea più documenti in nuove schede della stessa finestra, piuttosto che in nuove finestre.
  • Aumenta la produttività del 50% e riduce centinaia di clic del mouse ogni giorno!
fondo officetab
Commenti (61)
Rinomato 5 su 5 · Valutazioni 1
Questo commento è stato fatto dal moderatore sul sito
Funziona benissimo per me, ma c'è un modo per selezionare automaticamente la posizione di una cartella anziché selezionarla manualmente? Spero di farlo per 40 fogli in una volta.
Questo commento è stato fatto dal moderatore sul sito
Spero anche di vedere una risposta per questo problema! Grazie per l'aiuto!
Questo commento è stato fatto dal moderatore sul sito
Ho provato a incollarlo in un nuovo modulo e ottengo un errore di compilazione: sub o funzione non definita. Per favore aiuto.
Questo commento è stato fatto dal moderatore sul sito
Caro Darren,
Quale versione di Office usi?
Questo commento è stato fatto dal moderatore sul sito
Ufficio 360
Questo commento è stato fatto dal moderatore sul sito
Stesso problema
Questo commento è stato fatto dal moderatore sul sito
Come posso modificare lo script VBA sopra in modo che aggiunga una data e un'ora al nome del file in modo che non continui a sovrascrivere ciò che è già stato salvato?
Questo commento è stato fatto dal moderatore sul sito
Caro Michael,
Si prega di eseguire il codice VBA sottostante per risolvere il problema.

Sub Salva comepdfe invia()
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xStr come stringa

Imposta xSht = Foglio attivo
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
xStr = Formato(Ora(), "aaaa-mm-gg-hh-mm-ss")
xCartella = xCartella + "\" + xSht.Name + "-" + xStr + ".pdf"

'Verifica se il file esiste già
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
'Salva come file PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = ""
.CC = ""
.Oggetto = xSht.Name + "-" + xStr + ".pdf"
.Allegati.Aggiungi xCartella
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao Cristallo,

È davvero fantastico e funziona perfettamente per me. Hai bisogno di ulteriore aiuto per aggiungere:

1. in "A" voglio dare un collegamento a una cella particolare del foglio attivo come in CC e in BCC vorrei aggiungere un collegamento al foglio attivo
2. nel corpo dell'e-mail devo specificare del testo standard.

Sarò molto completo per te per il tuo aiuto.

Grazie
parag
Questo commento è stato fatto dal moderatore sul sito
Ciao Parag Somani,
Il codice VBA sottostante può aiutarti. Modifica i campi .To, .CC, .BCC e .Body in base alle tue esigenze.

Sub Salva comepdfe invia()
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xStr come stringa

Imposta xSht = Foglio attivo
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
xStr = Formato(Ora(), "aaaa-mm-gg-hh-mm-ss")
xCartella = xCartella + "\" + xSht.Name + "-" + xStr + ".pdf"

'Verifica se il file esiste già
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
'Salva come file PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = Intervallo("A8")
.CC = Intervallo("A9")
.BCC = Intervallo ("A10")
.Oggetto = xSht.Name + "-" + xStr + ".pdf"
.Corpo = "Caro" _
& vbNewLine & vbNewLine & _
"Questa è un'email di prova" & _
"invio in Excel"
.Allegati.Aggiungi xCartella
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ho provato a utilizzare l'intervallo per "A", "CC", semplicemente non raccoglie i valori dalla cella designata. Per favore, puoi aiutare su questo?
Grazie,
Mehul
Questo commento è stato fatto dal moderatore sul sito
Ciao Cristallo,

È davvero fantastico e funziona perfettamente per me. Hai bisogno di ulteriore aiuto per aggiungere:

1. in "A" voglio dare un collegamento a una cella particolare del foglio attivo come in CC e in BCC vorrei aggiungere un collegamento al foglio attivo
2. nel corpo dell'e-mail devo specificare del testo standard.

Sarò molto completo per te per il tuo aiuto.

Grazie
parag
Questo commento è stato fatto dal moderatore sul sito
Ciao Cristallo,

È davvero fantastico e funziona perfettamente per me. Hai bisogno di ulteriore aiuto per aggiungere:

1. in "A" voglio dare un collegamento a una cella particolare del foglio attivo come in CC e in BCC vorrei aggiungere un collegamento al foglio attivo
2. nel corpo dell'e-mail devo specificare del testo standard.

Sarò molto completo per te per il tuo aiuto.

Grazie
parag
Questo commento è stato fatto dal moderatore sul sito
Come posso aggiungere ad esempio il foglio 2 dalla cartella di lavoro come pdf?
Questo commento è stato fatto dal moderatore sul sito
Ciao Armin,
È necessario aprire prima il foglio 2 nella cartella di lavoro e quindi eseguire il codice VBA con i passaggi precedenti per eliminarlo.
Questo commento è stato fatto dal moderatore sul sito
Come posso modificare lo script VBA sopra in modo che il nome del file venga salvato come una cella specifica selezionata all'interno del foglio corrente, ad esempio la cella A1?
Questo commento è stato fatto dal moderatore sul sito
Ciao Tom.
Spiacente, non posso aiutare con questo.
Benvenuto per postare qualsiasi domanda nel nostro forum: https://www.extendoffice.com/forum.html
Riceverai più supporto per Excel dal nostro professionista di Excel o da altri fan di Excel.
Questo commento è stato fatto dal moderatore sul sito
Ciao, come posso salvare e inviare il pdf con il nome della cartella di lavoro con il codice VBA corrente? cosa uso invece di xSht.Name
Questo commento è stato fatto dal moderatore sul sito
Ciao James,
Vuoi inviare il foglio di lavoro attivo come pdf e nominarlo come nome della cartella di lavoro?
Questo commento è stato fatto dal moderatore sul sito
Grazie funziona.
Questo commento è stato fatto dal moderatore sul sito
Come posso fare in modo che elimini il pdf salvato dopo averlo inviato via email?
Questo commento è stato fatto dal moderatore sul sito
Ciao Jason,
Mi dispiace non poterti aiutare con quello ancora. È necessario eliminarlo manualmente dopo averlo inviato tramite e-mail.
Questo commento è stato fatto dal moderatore sul sito
Ciao,

È possibile trovare il nome del pdf da una cella? Ex. Cella H4


E nella cella H4 voglio che venga raccolto da tre celle diverse. È possibile?
Questo commento è stato fatto dal moderatore sul sito
Questo è possibile. Crea variabili separate per mantenere il valore dalle celle e quindi usa quelle variabili durante l'impostazione di xFolder.
Ho usato il valore di una cella nel mio foglio più la data odierna. Tuttavia, potresti facilmente eseguire più valori di cella.

Questo è quello che ho aggiunto:
Dim xMemberName come stringa
Dim xFileDate come stringa

xMemberName = Intervallo ("H3"). Valore
xFileDate = Formato(Ora, "mm-gg")

xCartella = xCartella + "\" xMemberName + xFileDate + ".pdf"
Questo commento è stato fatto dal moderatore sul sito
Ricevo un errore quando provo questo, dove nel codice dovrei inserirlo?
Questo commento è stato fatto dal moderatore sul sito
Ciao Cristallo,



È davvero fantastico e funziona perfettamente per me. Hai bisogno di ulteriore aiuto per aggiungere:

1. in "Corpo" voglio dare un collegamento a una cella particolare del foglio attivo. Inoltre vorrei mettere in grassetto il testo.

Grazie

Saluti

Kishore Kumar
Questo commento è stato fatto dal moderatore sul sito
Ciao,

Intendi aggiungere automaticamente il valore della cella al corpo della posta e metterlo in grassetto? Supponendo di aggiungere il valore di C4 al corpo della posta. Si prega di applicare il codice sottostante.

Sub Salva comepdfe invia()

Dim xSht come foglio di lavoro

Dim xFileDlg come FileDialog

Dim xCartella come stringa

Dim xYesorNo come intero

Dim xOutlookObj come oggetto

Dim xEmailObj come oggetto

Dim xUsedRng come intervallo



Imposta xSht = Foglio attivo

Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Se xFileDlg.Show = True allora

xCartella = xFileDlg.SelectedItems(1)

Altro

MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"

Exit Sub

End If

xCartella = xCartella + "\" + xSht.Name + ".pdf"



'Verifica se il file esiste già

Se Len(Dir(xFolder)) > 0 Allora

xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _

vbSìNo + vbDomanda, "Il file esiste")

On Error Resume Next

Se xSìorNo = vbSì Allora

Uccidi xCartella

Altro

MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _

& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"

Exit Sub

End If

Se Err.Number <> 0 Allora

MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _

& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"

Exit Sub

End If

End If



Imposta xUsedRng = xSht.UsedRange

Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora

'Salva come file PDF

xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard



'Crea e-mail di Outlook

Imposta xOutlookObj = CreateObject ("Outlook.Application")

Imposta xEmailObj = xOutlookObj.CreateItem(0)

Con xEmailObj

.Schermo

.A = ""

.CC = ""

.Oggetto = xSht.Nome + ".pdf"

.Allegati.Aggiungi xCartella

.HTMLBody = "
" & Intervallo ("C4") e .HTMLBody

Se DisplayEmail = False allora

'.Spedire

End If

Fine Con

Altro

MsgBox "Il foglio di lavoro attivo non può essere vuoto"

Exit Sub

End If

End Sub
Questo commento è stato fatto dal moderatore sul sito
Se volessi che si salvasse automaticamente in una cartella specifica ogni volta (eliminando la necessità per l'utente di scegliere la cartella), come lo farei?
Ex. C: Fatture/Nord America/Clienti
Aiuto è molto apprezzato.
Questo commento è stato fatto dal moderatore sul sito
Ciao Geoff,
Intendi salvare il foglio di lavoro come file pdf e salvarlo in una cartella specifica senza inviarlo?
Questo commento è stato fatto dal moderatore sul sito
Penso che Geoff significhi essere in grado di specificare una cartella specifica nel codice in cui viene salvato il pdf ogni volta piuttosto che dover selezionare la posizione manualmente. Il pdf viene quindi inviato via e-mail da quella cartella specifica.
Questo commento è stato fatto dal moderatore sul sito
Grazie Jeremy.
Questo commento è stato fatto dal moderatore sul sito
Ciao Geoff, se desideri salvare automaticamente il file pdf in una cartella specifica anziché selezionare la posizione manualmente, prova il codice seguente. Non dimenticare di cambiare il percorso della cartella nel codice.
Sub Salva come PDF e Invia ()
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xPath come stringa
Imposta xSht = Foglio attivo
xPercorso = "C:\Utenti\Win10x64Test\Desktop\foglio di lavoro in pdf" 'qui "workshet to pdf" è la cartella di destinazione in cui salvare i file pdf
xCartella = xPercorso + "\" + xSht.Name + ".pdf"
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
'Salva come file PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = ""
.CC = ""
.Oggetto = xSht.Nome + ".pdf"
.Allegati.Aggiungi xCartella
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Questo codice funziona alla grande tranne che voglio che il foglio di lavoro venga salvato come nome del foglio + data (es. Foglio1 1 ottobre 2020); sul desktop dell'utente (questo sarà utilizzato da più persone e i loro percorsi potrebbero variare leggermente). Se possibile, voglio incorporare anche un .jpg nel corpo.. il JPG si trova sia all'interno del foglio di lavoro (al di fuori dell'area di stampa) che l'immagine è archiviata su un server condiviso.. anche se il percorso del server varia in base a utente (per la maggior parte è un'unità "T" per alcuni un'unità "U")
Può essere fatto? per favore e grazie mille volte.
Questo commento è stato fatto dal moderatore sul sito

Ciao, funziona benissimo grazie per la condivisione, ho solo bisogno di un aiuto.
Se voglio salvare un file PDF con un nome personalizzato (opzione per digitare il nome del file nella finestra di dialogo Salva con nome), come utente utilizzare questa opzione nel modello di modulo in cui i moduli sono salvati come PDF con nome univoco.
Questo commento è stato fatto dal moderatore sul sito
Ciao, per favore prova il codice VBA qui sotto. Dopo aver eseguito il codice, seleziona una cartella in cui salvare il file PDF, quindi verrà visualizzata una finestra di dialogo in cui inserire il nome del file. Sub Saveaspdfandsend()
'Aggiornato da Extendoffice 20210209
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xStrName come stringa
Dim xV come variante

Imposta xSht = Foglio attivo
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Inserisci il nome del file:", "Ktools for Excel", , , , , , 2)
Se xV = Falso Allora
Exit Sub
End If
xStrNome = xV
Se xStrName = "" Allora
MsgBox ("Nessun nome file inserito, processo in uscita!")
Exit Sub
End If

xCartella = xCartella + "\" + xStrName + ".pdf"
'Verifica se il file esiste già
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
'Salva come file PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = ""
.CC = ""
.Oggetto = xSht.Nome + ".pdf"
.Allegati.Aggiungi xCartella
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao,
Se ho due fogli nel file e vorrei eseguire questa macro su un foglio (premendo il pulsante) ma inviarne un altro, come posso ottenerlo?
Questo commento è stato fatto dal moderatore sul sito
Ciao, vorrei salvarlo in una determinata posizione del file, con il nome basato sul valore nella cella C30. Ho provato alcune opzioni, ma continuo a ricevere errori.
Questo commento è stato fatto dal moderatore sul sito
Ciao hein, il codice qui sotto forse può aiutare. Dopo aver eseguito il codice, seleziona una determinata cartella in cui salvare il file PDF, quindi verrà visualizzata una finestra di dialogo in cui inserire il nome del file. Sub Saveaspdfandsend()
'Aggiornato da Extendoffice 20210209
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xStrName come stringa
Dim xV come variante

Imposta xSht = Foglio attivo
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Inserisci il nome del file:", "Ktools for Excel", , , , , , 2)
Se xV = Falso Allora
Exit Sub
End If
xStrNome = xV
Se xStrName = "" Allora
MsgBox ("Nessun nome file inserito, processo in uscita!")
Exit Sub
End If

xCartella = xCartella + "\" + xStrName + ".pdf"
'Verifica se il file esiste già
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
'Salva come file PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = ""
.CC = ""
.Oggetto = xSht.Nome + ".pdf"
.Allegati.Aggiungi xCartella
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Grazie per questo, è fantastico, ma voglio che il foglio sia nominato come da cella A1 sul foglio 1. il posto da salvare come da A1 sul foglio 2, ad esempio C:\Users\peete\Dropbox\Screenshots, e inviare un'e-mail a indirizzo email sul foglio A3 2 quello che ho già elaborato.
Questo commento è stato fatto dal moderatore sul sito
Grazie per questo, è fantastico, ma voglio che il foglio sia nominato come da cella A1 sul foglio 1. il posto da salvare come da A1 sul foglio 2, ad esempio C:\Users\peete\Dropbox\Screenshots, ma può cambiare quando utilizzando il file e invia un'e-mail all'indirizzo e-mail sul foglio A3 2 ciò che ho già elaborato.
Questo commento è stato fatto dal moderatore sul sito
Hi cristallo , codice eccellente grazie per la condivisione. C'è un modo per selezionare più fogli (dalla stessa cartella di lavoro) per salvarli ciascuno come PDF indipendente e quindi inviarli tutti allegati in un'unica e-mail?
Questo commento è stato fatto dal moderatore sul sito
Ciao, il codice VBA sottostante può farti un favore, per favore prova. Nella dodicesima riga del codice, sostituisci i nomi dei fogli con i nomi dei fogli effettivi nel tuo caso.
Sub Saveaspdfandsend1()
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo, I, xNum As Integer
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xArrShetts come variante
Dim xPDFNameAddress come stringa
Dim xStr come stringa
xArrShetts = Array("test", "Foglio 1", "Foglio 2") 'Inserisci i nomi dei fogli che invierai come file pdf racchiusi tra virgolette e separali con virgola. Assicurati che non ci siano caratteri speciali come \/:"*<>| nel nome del file.

For I = 0 A UBound(xArrShetts)
On Error Resume Next
Imposta xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Se xSht.Name <> xArrShetts(I) Allora
MsgBox "Foglio di lavoro non trovato, operazione di uscita:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Successiva


Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
'Verifica se il file esiste già
xYesorNo = MsgBox("Se nella cartella di destinazione esistono file con lo stesso nome, il suffisso numerico verrà aggiunto automaticamente al nome del file per distinguere i duplicati" & vbCrLf & vbCrLf & "Fai clic su Sì per continuare, fai clic su No per annullare", _
vbSìNo + vbDomanda, "Il file esiste")
Se xSìoNo <> vbSì Quindi esci da Sub
For I = 0 A UBound(xArrShetts)
Imposta xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xCartella & "\" & xSht.Name & ".pdf"
xNumero = 1
Mentre non (Dir(xStr, vbDirectory) = vbNullString)
xStr = xCartella & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xStr, Qualità:=xlQualityStandard
Altro

End If
xArrShetts(I) = xStr
Successiva

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = ""
.CC = ""
.Oggetto = "????"
For I = 0 A UBound(xArrShetts)
.Allegati.Aggiungi xArrShetts(I)
Successiva
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, l'unico cambiamento con cui sto lottando è creare un'e-mail separata per ogni documento pdf creato.
Questo commento è stato fatto dal moderatore sul sito
Ciao, per creare un'e-mail separata per ogni documento pdf, puoi eseguire manualmente il VBA fornito nel post in diversi fogli di lavoro per farlo.
Questo commento è stato fatto dal moderatore sul sito
Ho più di 100 fogli di lavoro nella cartella di lavoro, il che comporterà quindi che devo eseguire VBA più di 100 volte, il che richiede tempo.  
Sono riuscito a dividere la mia cartella di lavoro in più fogli e quindi sono in grado di convertire ogni foglio di lavoro in un singolo documento PDF.
La soluzione che sto cercando è inviare via e-mail ogni documento PDF separatamente mentre il processo di cui sopra è in esecuzione.
Di seguito il VBA che sto attualmente eseguendo:
Sub Salva comepdfe invia1()
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo, I, xNum As Integer
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xArrShetts come variante
Dim xPDFNameAddress come stringa
Dim xStr come stringa
xArrShetts = Array("02302257", "02400438", "02401829", "02403995", "02408001", "02409208", _
"02409980", "02411881", "02424178", "02430454", "02444046", "02448950", "02450600", _
"02459861", "02461750", "02467535", "02480484", "02484749", "02502041", "02504807", _
_
"02530381", "02531018", "02531252", "02531277", "02532571", "02533053", "02533474", _
"02534176", "02534592", "02534626", "02535343", "02536386", "02536921", "02537544", _
_
"02543763", "02543985", "02544116", "02544748", "02544762", "02545026", "02545048", _
"02545080", "02545447", "02545730", "02545814", "02546477", "02547458", "02547673", _
_
"02549462", "02549499", "02549565", "02549687", "02550049", "02550437", "02550812", _
"02550982", "02551004", "02551005", "02551045", "02552099", "02552222", "02552561", _
_
"02559121", "02559392", "02559419", "02559512", "02559802", "02559868", "02560052", _
"02560612", "02560684", "02560920", "02561018", "02561061", "02561092", "02561227", _
_
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Inserisci i nomi dei fogli che invierai come file pdf racchiusi tra virgolette e separali con virgola. Assicurati che non ci siano caratteri speciali come \/:"*<>| nel nome del file.

For I = 0 A UBound(xArrShetts)
On Error Resume Next
Imposta xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Se xSht.Name <> xArrShetts(I) Allora
MsgBox "Foglio di lavoro non trovato, operazione di uscita:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Successiva


Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
'Verifica se il file esiste già
xYesorNo = MsgBox("Se nella cartella di destinazione esistono file con lo stesso nome, il suffisso numerico verrà aggiunto automaticamente al nome del file per distinguere i duplicati" & vbCrLf & vbCrLf & "Fai clic su Sì per continuare, fai clic su No per annullare", _
vbSìNo + vbDomanda, "Il file esiste")
Se xSìoNo <> vbSì Quindi esci da Sub
For I = 0 A UBound(xArrShetts)
Imposta xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xCartella & "\" & xSht.Name & ".pdf"
xNumero = 1
Mentre non (Dir(xStr, vbDirectory) = vbNullString)
xStr = xCartella & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xStr, Qualità:=xlQualityStandard
Altro

End If
xArrShetts(I) = xStr
Successiva

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Oggetto = "????"
For I = 0 A UBound(xArrShetts)
On Error Resume Next
.Allegati.Aggiungi xArrShetts(I)
Successiva
Se DisplayEmail = False allora
.Spedire
Exit Sub
End If
Fine Con


End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao @cristallo
Questo è favoloso - la cosa chiave con cui sto lottando è il nome del file - vorrei che il nome del file venisse estratto da una cella nel foglio di lavoro piuttosto che usare il nome della scheda. Ho già modificato il codice per salvarlo automaticamente in una cartella specificata, ma sto lottando con il nome del file.
Qualche aiuto che puoi offrire per favore?
Questo commento è stato fatto dal moderatore sul sito
Ciao Tori, se desideri assegnare un nome al file PDF con un valore di cella specifico, prova il seguente codice. Dopo aver eseguito il codice e selezionato una cartella in cui salvare il file, viene visualizzata un'altra finestra di dialogo, seleziona la cella che utilizzerai il valore come nome del file PDF, quindi fare clic su OK per terminare.
Sub Saveaspdfandsend2()
'Aggiornato da Extendoffice 20210521
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng, xRgInser come intervallo
Dim xB come booleano
Imposta xSht = Foglio attivo
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
xB = Vero
On Error Resume Next
Mentre xB
Imposta xRgInser = Niente
Set xRgInser = Application.InputBox("Seleziona una cella in cui utilizzerai il valore per assegnare un nome al file PDF:", "Ktools for Excel", , , , , , 8)
Se xRgInser non è niente allora
MsgBox " Nessuna cella selezionata, esci dall'operazione!", vbInformation, "Ktools for Excel"
Exit Sub
End If
Se xRgInser.Text = "" Allora
MsgBox " La cella selezionata è vuota, per favore riseleziona! ", vbInformation, "Ktools for Excel"
Altro
xB = Falso
End If
Wend

xCartella = xCartella + "\" + xRgInser.Text + ".pdf"

'Verifica se il file esiste già
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
'Salva come file PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = ""
.CC = ""
.Oggetto = xSht.Nome + ".pdf"
.Allegati.Aggiungi xCartella
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, avevo bisogno di qualcosa di simile, quindi ecco cosa ho ottenuto. Prende la data corrente e crea una nuova cartella con il nome della data in una posizione specifica. Posiziona il pdf all'interno di quella nuova posizione, quindi allega il pdf in una nuova e-mail. Funziona come una delizia. Sono solo un principiante quindi per favore scusami se sembra un pasticcio. :D
Sub PDFTOEMAIL()
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xPath come stringa
Dim xOutMsg come stringa
Dim sFolderName As String, sFolder As String
Dim sFolderPath come stringa

Imposta xSht = Foglio attivo
xFileDate = Formato(Ora, "gg-mm-aaaa")
sFolder = "C:" 'qui è dove hai una cartella principale
sFolderName = "Fine settimana" + Formato(Ora, "gg-mm-aaaa") 'cartella da creare nella cartella principale con nome Fine settimana e data corrente
sFolderPath = "C:" & sFolderName 'di nuovo la cartella principale per creare il nuovo percorso inclusa la nuova cartella
Imposta oFSO = CreateObject("Scripting.FileSystemObject")
Se oFSO.FolderExists(sFolderPath) Allora
MsgBox "La cartella esiste già!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Altro
MkDir sFolderPath
MsgBox "Nuova cartella creata!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xCartella = xPercorso + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Si prega di trovare in allegato Questa email e allegato sono stati generati automaticamente "
'aggiunge una nota che l'e-mail è stata generata automaticamente

Con xEmailObj
.Schermo
.To = "" 'aggiungi le tue email
.CC = ""
.Subject = xSht.Name + " PDF per fine settimana " + xFileDate + " - Posizione" ' l'oggetto include il nome del foglio, il pdf, la data e la posizione, questo può essere modificato secondo necessità
.Allegati.Aggiungi xCartella
.HTMLBody = xOutMsg e .HTMLBody
Se DisplayEmail = False allora
'.Invia <--- Qui se elimini l'apostrofo l'e-mail verrà inviata automaticamente, quindi fai attenzione
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Come modifico questo codice per salvare solo le celle ("a1:r99") da salvare come PDF. Ho cose extra sui lati che non voglio nel mio documento PDF.
Sub Salva comepdfe invia()
'Aggiornato da Extendoffice 20210209
Dim xSht come foglio di lavoro
Dim xFileDlg come FileDialog
Dim xCartella come stringa
Dim xYesorNo come intero
Dim xOutlookObj come oggetto
Dim xEmailObj come oggetto
Dim xUsedRng come intervallo
Dim xStrName come stringa
Dim xV come variante

Imposta xSht = Foglio attivo
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Se xFileDlg.Show = True allora
xCartella = xFileDlg.SelectedItems(1)
Altro
MsgBox "Devi specificare una cartella in cui salvare il PDF." & vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Deve specificare la cartella di destinazione"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Inserisci il nome del file:", "Ktools for Excel", , , , , , 2)
Se xV = Falso Allora
Exit Sub
End If
xStrNome = xV
Se xStrName = "" Allora
MsgBox ("Nessun nome file inserito, processo in uscita!")
Exit Sub
End If

xCartella = xCartella + "\" + xStrName + ".pdf"
'Verifica se il file esiste già
Se Len(Dir(xFolder)) > 0 Allora
xYesorNo = MsgBox(xFolder & " esiste già." & vbCrLf & vbCrLf & "Vuoi sovrascriverlo?", _
vbSìNo + vbDomanda, "Il file esiste")
On Error Resume Next
Se xSìorNo = vbSì Allora
Uccidi xCartella
Altro
MsgBox "se non sovrascrivi il PDF esistente, non posso continuare." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Uscita dalla macro"
Exit Sub
End If
Se Err.Number <> 0 Allora
MsgBox "Impossibile eliminare il file esistente. Assicurati che il file non sia aperto o protetto da scrittura." _
& vbCrLf & vbCrLf & "Premi OK per uscire da questa macro.", vbCritical, "Impossibile eliminare il file"
Exit Sub
End If
End If

Imposta xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Allora
'Salva come file PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome file:=xFolder, Qualità:=xlQualityStandard

'Crea e-mail di Outlook
Imposta xOutlookObj = CreateObject ("Outlook.Application")
Imposta xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Schermo
.A = ""
.CC = ""
.Oggetto = xSht.Nome + ".pdf"
.Allegati.Aggiungi xCartella
Se DisplayEmail = False allora
'.Spedire
End If
Fine Con
Altro
MsgBox "Il foglio di lavoro attivo non può essere vuoto"
Exit Sub
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, ho appena provato questo codice su uno dei miei fogli di lavoro e ho impostato le aree di stampa in modo che le cose extra in basso non siano visualizzate nel pdf. Provalo!
Questo commento è stato fatto dal moderatore sul sito
Hi
Molte grazie per il codice, ma è possibile salvare automaticamente il PDF nella stessa posizione del file Excel attivo e con lo stesso nome file del file Excel attivo?
Molte grazie.
Asta
Non ci sono ancora commenti pubblicati qui
Carica Altre
Lasciate i vostri commenti
Pubblicazione come ospite
×
Valuta questo post:
0   Personaggi
Posizioni suggerite