Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Macro VBA - selezione e salvataggio PDF di + fogli

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Macro VBA - selezione e salvataggio PDF di + fogli

Postdi solideo1971 » 30/08/18 12:08

Salve a tutti,
ovviamente sono nuovo del forum, e mi scuso anticipatamente se faccio errori /omissioni / sviste.

Ho una cartella costituita da 38 fogli di calcolo.

Vorrei creare un pulsante/macro in vba che dal foglio principale, tramite finestra di dialogo (pensavo una finestra dove sono presenti tutti i fogli e ticcare quelli che mi servono), mi esporti i fogli in pdf in un unico file a cui posso assegnare di volta in volta il nome.

Spero di essere stato abbastanza chiaro.
In attesa vi ringrazio anticipatamente dei suggerimenti che vorrete darmi
Saluti
Crescenzo
solideo1971
Newbie
 
Post: 1
Iscritto il: 30/08/18 11:49

Sponsor
 

Re: Macro VBA - selezione e salvataggio PDF di + fogli

Postdi Anthony47 » 30/08/18 22:12

Allora la mia proposta e' questa:

Aggiungi un Foglio che chiami Index, che sara' usato per creare l'indice dei fogli e "spuntare" quelli da salvare in pdf.
Fai "tasto dx" sul tab col nome Index; scegli Visualizza codice; copia questo codice e inseriscilo nella pagina dell'editor delle macro che cosi' e' stato aperto:
Codice: Seleziona tutto
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Se doppiclick su B1, cancella elenco:
If Target.Address = "$B$1" Then
    Range("Intrv").ClearContents
    Cancel = True
    Exit Sub
End If
'Se doppioclick nell'elenco, metti /togli la spunta:
If Not Application.Intersect(Range("Intrv"), Target) Is Nothing Then
    If Target.Value = "" Then Target.Value = "ü" Else Target.Value = ""
    Target.Font.Name = "Wingdings"
    Cancel = True
End If
End Sub

Questo servira' per mettere /togliere le "spunte" ai fogli: facendo "doppioclick" nella cella di colonna B accanto a un nome foglio viene alternativamente messa/tolta la spunta; facendo doppioclick in B1 cancelli tutte le spunte

Ora, sempre nell'editor delle macro, fai Menu /Inserisci /Modulo.

Copia questo codice e incollalo nel modulo appena creato:
Codice: Seleziona tutto
Sub CRindex()
Dim I As Long
'Crea l' Indice dei fogli in colonna A:
Sheets("Index").Select
Range("A:B").ClearContents
For I = 1 To ThisWorkbook.Sheets.Count
    If Sheets(I).Name <> "Index" Then
        Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Sheets(I).Name
        Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).ClearContents
    End If
Next I
Range("A1:B1").Value = Array("NomeFoglio", "Selezione")
'Crea l'intervallo delle "spunte"
Range("B2").Resize(I - 2, 1).Name = "Intrv"
'Imposta visualizzazione colonne:
Columns("A:B").EntireColumn.AutoFit
Range("A:A").ColumnWidth = Range("A:A").ColumnWidth * 1.25
End Sub


Sub PdfMultiSh()
Dim WSA(), myC As Range, IInd As Long, PFName As String
Dim XlsF As String, extP As Long, IFName As String
'
ReDim WSA(1 To ThisWorkbook.Sheets.Count)
'Crea elenco fogli selezionati:
With Sheets("Index")
    For Each myC In .Range("Intrv")
        If myC.Value = "ü" Then
            WSA(IInd + 1) = myC.Offset(0, -1).Value
            IInd = IInd + 1
        End If
    Next myC
End With
If IInd = 0 Then Exit Sub       'Termina se nessuna selezione
ReDim Preserve WSA(1 To IInd)
'
Sheets(WSA).Select
'Chiedi Nome del file:
XlsF = ActiveWorkbook.Name
extP = InStrRev(XlsF, ".", , vbTextCompare)
If extP = 0 Then extP = 999
IFName = ActiveWorkbook.Path & "\" & Left(XlsF, extP) & "pdf"
PFName = Application.GetSaveAsFilename(InitialFileName:=IFName, FileFilter:="pdf files, *.pdf", Title:="Scegli Nome Pdf File")
If PFName = CStr(False) Then        'Se nessuna scelta
    MsgBox ("Nessun nome scelto, la procedura viene interrotta")
    GoTo exitA
Else
    'Stampa:
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PFName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    MsgBox ("Compilato file " & PFName)
End If
'Uscita:
exitA:
    Sheets("Index").Select
    Range("A1").Select
End Sub


Questo codice comprende due macro:
1) la Sub Crindex, che crea in colonna A di Index l'elenco dei fogli presenti (eccetto Index). Questa va eseguita quando non sei certo che l'elenco comprenda tutti i nomi dei fogli presenti nel file; puoi comunque eseguirla quando vuoi, tieni solo presente che cancella tutte le spunte eventualmente gia' messe

2) la Sub PdfMultiSh, che crea il file pdf dei fogli selezionati su foglio Index. Quando la avvii ti verra' chiesto di selezionare un percorso e un nome per il file da creare.

Quindi, riepilogando:
-aggiungi il foglio Index e metti il suo codice
-aggiungi il Modulo vuoto all'editor delle macro e copiaci il secondo codice

-esegui la Sub Crindex per creare l'indice dei Fogli

-fai doppioclick in colonna B accanto a un nome foglio per mettere /togliere la spunta ai fogli di interesse
-se fai doppioclick su B1 invece l'elenco delle spunte viene azzerato

-quando sei pronto esegui la Sub PdfMultiSh, scegli il nome file e completa il salvataggio; un messaggio segnalera' il completamento e il percorso /nomefile creato

Per eseguire una macro, da Excel:
-premi Alt-F8; scegli la macro da eseguire dall'elenco delle macro disponibili, premi Esegui

Oppure inserisci in foglio Index due pulsanti, prelevandoli dal gruppo "Moduli", e gli assegni le due macro di cui abbiamo parlato

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 17453
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro VBA - selezione e salvataggio PDF di + fogli

Postdi Lion_ » 24/02/19 12:23

Buongiorno,

se volessi stampare in fogli PDF separati, cioè ogni foglio un distinto file, che istruzione dovrei inserire all'interno di Crindex? E inserire l'ulteriore istruzione di invio di mail separate, per ciascun PDF, ad un contatto mail ed un altro in c/c?

Grazie per l'aiuto.
Lion_
Newbie
 
Post: 4
Iscritto il: 14/02/19 21:58

Re: Macro VBA - selezione e salvataggio PDF di + fogli

Postdi Anthony47 » 24/02/19 21:35

Se vuoi usare l'approccio proposto a solideo /crescenzo, allora devi sostituire la parte da Sheets(WSA).Select a End If (inclusi) con:
Codice: Seleziona tutto
For I = 1 To IInd
    Sheets(wsa(I)).Select
    'Chiedi Nome del file:
    XlsF = ActiveWorkbook.Name
    extP = InStrRev(XlsF, ".", , vbTextCompare)
    If extP = 0 Then extP = 999
    IFName = ActiveWorkbook.Path & "\" & Left(XlsF, extP) & Format(I, "_000") & "pdf"
    PFName = Application.GetSaveAsFilename(InitialFileName:=IFName, FileFilter:="pdf files, *.pdf", Title:="Scegli Nome Pdf File")
    If PFName = CStr(False) Then        'Se nessuna scelta
        MsgBox ("Nessun nome scelto, la procedura viene interrotta")
        GoTo exita
    Else
        'Stampa:
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PFName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
        MsgBox ("Compilato file " & PFName)
    End If
Next I


In questo modo a ogni foglio "spuntato" nell'Indice verra' assegnato un nome file che e' impostato come NomeFileExcel_00x.pdf (con 00x che cambia da 001, 002, 003, ...) ma deve essere confermato (o modificato) dall'operatore.

Quanto all'invio automatico di email, ci sono state numerose realizzazioni; fai una ricerca nel forum con la chiave "invioemail" e vedi come riesci ad adattarla alla tua esigenza.
Se non ci riesci allora ti chiedo di aprire una nuova discussione in cui chiarisci quale e' l'organizzazione dei dati e quale logica va realizzata.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17453
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro VBA - selezione e salvataggio PDF di + fogli

Postdi Lion_ » 25/02/19 23:28

Grazie era proprio ciò che faceva al caso mio: ti ringrazio per la chiarezza del Tuo intervento!

Per l'invio delle mail io ho scritto ciò che allego qui sotto, ma quello che non riesco a far eseguire e far pescare ciascun pdf, precedentemente creato, sempre in base a quell'elenco INDEX: uno riesce ad allegarlo ma il secondo, terzo... fogli riallega sempre il primo.
Premetto che indicare il percorso del file pdf, nel caso mio, varierebbe ogni giorno e quindi come strada non è percorribile.


Codice: Seleziona tutto
'INVIO MAIL con ALLEGATO FILE

Set MioWBK = ActiveWorkbook
Set MioSheet = ActiveWorkbook.Sheets("Foglio1")
miaDir = MioWBK.Path

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

On Error Resume Next
Set AppMail = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
    Err.Clear
    Set AppMail = CreateObject("Outlook.Application")
    AppMail.Session.Logon

    If Err <> 0 Then
        MsgBox "Could not load Outlook", vbOKOnly + vbInformation, "Error report"
        End
    End If
End If


If PFName = CStr(False) Then        'Se nessuna scelta
    End
End If
   
indirizziTO = MioSheet.Range("M2") 'INDIRIZZO MAIL
IndirizziCC = MioSheet.Range("M3") 'INDIRIZZO CC MAIL
Set NewMail = AppMail.CreateItem(0)

Oggetto = ""
   MsgBox ("Inviato file VIA MAIL")

With NewMail
    .To = indirizziTO
    .CC = IndirizziCC
    .Subject = Oggetto
    .body = Testo & .body
    .Attachments.Add PFName    'ALLEGA FILE
    .Display       'NON INVIA MAIL: attende mio ordine
   
End With



Grazie dell'aiuto!

Ciao
Lion_
Newbie
 
Post: 4
Iscritto il: 14/02/19 21:58

Re: Macro VBA - selezione e salvataggio PDF di + fogli

Postdi Anthony47 » 26/02/19 01:30

Io non ho idea di come sia il tuo processo complessivo; la prima macro crea le stampe pdf dei fogli che risultano "spuntati" dall'elenco fogli, e genera dei nomi che hanno un suffisso 001, 002, etc.; devi lavorare su quello per inserire un attachment diverso caso per caso.

Ma se l'indirizzo di destinazione e' sempre lo stesso (indirizziTO = MioSheet.Range("M2")) ha senso penare per creare N attachment diversi e poi N mail diverse? Non e' sufficiente creare un unico pdf (come si faceva originariamente per l'utente solideo) e inviare una unica mail?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17453
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro VBA - selezione e salvataggio PDF di + fogli

Postdi Lion_ » 12/03/19 21:42

Ciao,

creati i pdf, grazie alla preziosa modifica che mi hai detto sopra, ho preso spunto dalla macro, che allego, per generare la mail con allegato; cambiando pc però mi esce l'errore seguente "Errore di run.time '-2147417851 (80010105)'- Metodo 'To' dell'oggetto '_Mailtem' non riuscito". Potrebbe essere il collegamento al server mail, pur utilizzando coumunque Outlook, che manda in tilt la macro in questione? Senza strovolgerla completamente come potrei modificarla?

Grazie per l'aiuto, ciao

Codice: Seleziona tutto
Sub Invia_Email()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailAddr As String
    Dim Subj As String
    Dim BodyText As String
   
    Foglio8.Select
   
' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)
    RR = Range("B" & Rows.Count).End(xlUp).Row
   
' I dati iniziano dalla seconda riga
    For I = 2 To RR
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
       
' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
            .To = Cells(I, 2)
           
' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
            .CC = Cells(I, 3)
           
' Eventuale e-mail in "Copia per conoscenza nascosta"
            .BCC = ""
           
' La colonna "D" contiene l'oggetto della e-mail
            .Subject = Cells(I, 4)
           
' La colonna "E" contiene l testo della e-mail
            .Body = Cells(I, 5)

' La colonna "F" contiene il percorso ove si trova il file da allegare
' La colonna "G" contiene il nome del file da allegare
           
            .Attachments.Add (Cells(I, 6) & Cells(I, 7))
            .Display
           
    End With
       
        Set OutMail = Nothing
        Set OutApp = Nothing
        Application.SendKeys "%a"
    Next I
   
End Sub
Lion_
Newbie
 
Post: 4
Iscritto il: 14/02/19 21:58

Re: Macro VBA - selezione e salvataggio PDF di + fogli

Postdi Anthony47 » 13/03/19 00:05

Mah...
Hai un pc su cui quel foglio excel e quella macro lavorano, giusto? Quale e' la configurazione di quel sistema? Sistema Operativo e versione Office, tipo di account di posta (pop3 / Imap)
E quale e' invece la configurazione del Pc su cui lo stesso foglio e la stessa macro vanno in errore?

Si ferma al primo invio, o qualche ciclo funziona e poi si blocca? (cioe': a schermo vedi qualcuna delle mail preparate e pronte per essere inviate?)

Comunque, per prova fai queste modifiche:
-invece di .To = Cells(I, 2) inserisci
Codice: Seleziona tutto
    EmailAddr = Cells(I, 2)
    .To = EmailAddr

E se non cambia nulla allora invia le informazioni che ho indicato.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17453
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Macro VBA - selezione e salvataggio PDF di + fogli":


Chi c’è in linea

Visitano il forum: Nessuno e 47 ospiti