Condividi tramite

Creare tanti File PDF con stampa unione di Word su base dati in Excel.

Anonimo
2015-09-01T09:34:22+00:00

Buongiorno a tutti gli amici della community.

Devo predisporre tanti file pdf da un elenco di Excel che ha 215 colonne di dati.

Chiedo il vostro competente e prezioso aiuto per poter  creare i File Pdf e salvarli in una determinata cartella prendendo come nome dei vari file i dati di 3 campi che si chiamano Matricola; Grado e Cognome e Nome.

Inoltre desidero che i file PDF riportino pure la data e l'ora di salvataggio.

Ringrazio anticipatamente per l'aiuto fornito.

Ciao Nicola.

Microsoft 365 e Office | Excel | Per la casa | Windows

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
  1. Anonimo
    2015-09-03T13:25:57+00:00

    Ciao Nicola,

    Si può già vedere un elenco sequenziale dei nomi dei file pdf, mentre vengono salvati, sulla barra di stato di Word.

    Nel caso di grandi quantità di file, di peso multi-megabte, Word fornisce una barra di avanzamento integrato. Io ho provato il mio codice per salvare 50 file, ognuno di 8.5MB, caricati con  50 colonne x 2000 righe di numeri casuali, e sono stato ricompensato con la seguente barra di avanzamento:

    Per ricevere un rapporto di MsgBox al termine dell'operazione di stampa  richiede solo un paio di righe in più di codice; sostituisci le righe:

            Next i

        End With

    con:

            Next i

        End With

        Call MsgBox(Prompt:="Ci sono stati salvati " _

                          & i & " file pdf", _

                    Buttons:=vbInformation, _

                    Title:="FINITO")

    ===

    Regards,

    Norman

    0 commenti
Risposta accettata dall'autore della domanda
  1. Anonimo
    2015-09-01T23:33:50+00:00

    Ciao Nicola,

    Ho scaricato i tuoi due file.

    Io non avevo capito che volevi  utilizzare MailMerge per creare i file pdf. Comunque se questo sia il tuo obiettivo, non mi pare che tu abbia creato un documento MailMerge.  Pertanto, per provare il codice, ho creato un documento mailMerge banale:

    Ho poi modificato il codice dell'altro thread di Barbara per gestire le tue esigenze. Quindi, nel modulo1 del tuo file Word, ho sostituito il tuo codice  con la seguente versione:

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

    Option Explicit

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

    Public Sub Tester()

        Dim MyDoc As Document

        Dim sStr As String, sName As String, sPath As String

        Dim i As Long, j As Long

        Const sPercorsoDestinazione As String = _

                                           "C:\Users\Nicola"                      '<<=== Modifica

        On Error GoTo ErrHandler

        With Application

            sStr = .PathSeparator

            .ScreenUpdating = False

        End With

        If Right(sPercorsoDestinazione, 1) = sStr Then

            sPath = sPercorsoDestinazione

        Else

            sPath = sPercorsoDestinazione & sStr

        End If

        Set MyDoc = ThisDocument

        With MyDoc

            For i = 1 To .MailMerge.DataSource.RecordCount

                With .MailMerge

                    .Destination = wdSendToNewDocument

                    .SuppressBlankLines = True

                    With .DataSource

                        .FirstRecord = i

                        .LastRecord = i

                        .ActiveRecord = i

                        If Trim(.DataFields("Matricola")) = "" Then

                            Exit For

                        End If

                        sName = .DataFields("Matricola") _

                              & "_" _

                              & .DataFields("Grado") _

                              & "_" _

                              & .DataFields("Cognome_e_Nome") _

                              & Format(Now, "yyyymmdd hh-mm")

                    End With

                    .Execute Pause:=False

                End With

                For j = 1 To 255

                    Select Case j

                    Case 1 To 31, 33, 34, 37, 42, 44, 46, 47, _

                         58 - 63, 91 - 93, 96, 124, 147, 148

                        sName = Replace(sName, Chr(j), "")

                    End Select

                Next

                sName = Trim(sName)

                With ActiveDocument

                    .SaveAs FileName:=sPath & sName & ".pdf", _

                            FileFormat:=wdFormatPDF, _

                            AddToRecentFiles:=False

                    .Close SaveChanges:=False

                End With

            Next i

        End With

    XIT:

        On Error GoTo 0

        Application.ScreenUpdating = True

        Exit Sub

    ErrHandler:

        Call MsgBox(Prompt:=Err.Description & " " & Err.Number, _

                    Buttons:=vbCritical, _

                    Title:="Errore")

        Resume XIT

    End Sub

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

    Nota anche che, prima di creare il documento MailMerge, ho cancellato uno spazio finale nella intestazione Cognome e Nome nella cella B1 su Foglio1 del tuo file Excel.

    Eseguendo questo codice, nella directory C:\users\Nicola, ho ottenuto i seguenti nove file pdf:

    Noterai che, come richiesto questi file hanno una struttura di nome del tipo:

    Matricola + Grado + Cognome e Nome + data e l'ora di salvataggio.

    I file pdf salvati sono della forma:

    Ovviamente, sarà necessario adattare il documento di unione in accordo con le tue esigenze, ma il codice dovrebbe funzionare indipendentemente dal layout del documento finale.

    Potresti scaricare i miei file di prova Nicola20150901.docm e Nicola#2_20150901.xlsm a:   http://1drv.ms/1VuWk5c

    ===

    Regards,

    Norman

    0 commenti

27 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2015-09-01T11:58:58+00:00

    Ciao Nicola,

    L'errore che hai riscontrato suggerirebbe che non ci siano stati trovati alcuni dati nella colonna A del Foglio1 del tuo file. Potresti postare un immagine delle prime dieci righe del tuo foglio e verificare che il suo nome sia Foglio1?

    Nel frattempo, potresti scaricare il mio file di prova Nicola20150901.xlsm, il quale è basato su un vecchio file tuo, a:

                                         **http://1drv.ms/1hunA4A**

    Nota, che nel file caricato. per rendere visibile all'utente il progresso della procedura sulla barra di stato, nel codice, ho sostituito la riga:

            sFileName = sPath & aStr & ".pdf"

    con:

            sFileName = sPath & aStr & ".pdf"

            Application.StatusBar = "Record " & i & " di " & UBound(arrIn, 1)

    e la riga

        Next i

    con:

        Next i

        Application.StatusBar = False

    ===

    Regards,

    Norman

    0 commenti
  2. Anonimo
    2015-09-01T11:10:25+00:00

    Ciao Norman innanzitutto grazie per il tuo gentile e prezioso intervento.

    Il codice mi va in errore qui: arrIn = Rng.Value

    Ti posto sia l'immagine dell'errore che il codice che ho adattato alle mie colonne e al mio foglio di Excel.

     Const sPercorsoDestinazione As String = _

                                            "C:\Users\NIcola\Desktop\Nuova cartella"                    '<<===== Modifica

         Const PrimaRigaDati As Long = 2                          '<<===== Modifica

         Const colMatricola As String = "B"                             '<<===== Modifica

         Const colGrado As String = "C"                                   '<<===== Modifica

         Const colNomeCognome As String = "D"                  '<<===== Modifica

         Const sNomeFoglio As String = " Foglio1"         

    Ti ringrazio e ti saluto.

    Ciao Nicola

    0 commenti
  3. Anonimo
    2015-09-01T10:34:14+00:00

    Ciao Nicola,

    Prova qualcosa del genere:

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

    Option Explicit

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

    Public Sub Tester()

        Dim WB As Workbook

        Dim SH As Worksheet

        Dim Rng As Range, rCell As Range

        Dim arrIn As Variant

        Dim aStr As String, sStr As String

        Dim sPath As String, sFileName As String

        Dim LRow As Long

        Dim i As Long, x As Long, y As Long, z As Long

        Const sPercorsoDestinazione As String = _

                                           "C:\Users\Nicola"                    '<<===== Modifica

        Const PrimaRigaDati As Long = 10 '<<===== Modifica

        Const colMatricola As String = "B"                             '<<===== Modifica

        Const colGrado As String = "C"                                   '<<===== Modifica

        Const colNomeCognome As String = "D"                 '<<===== Modifica

        Const sNomeFoglio As String = "Foglio1"          <<===== Modifica

        Set WB = ActiveWorkbook

        Set SH = WB.Sheets(sNomeFoglio)

        sStr = Application.PathSeparator

        If Right(sPercorsoDestinazione, 1) = sStr Then

            sPath = sPercorsoDestinazione

        Else

            sPath = sPercorsoDestinazione & sStr

        End If

        With SH

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

            Set Rng = .Range("A" & PrimaRigaDati _

                           & ":" & colNomeCognome & LRow)

            x = .Columns(colMatricola).Column

            y = .Columns(colGrado).Column

            z = .Columns(colNomeCognome).Column

        End With

        arrIn = Rng.Value

        For i = LBound(arrIn, 1) To UBound(arrIn, 1)

            aStr = arrIn(i, x) _

                 & "_" _

                 & arrIn(i, y) _

                 & "_" _

                 & arrIn(i, z) _

                 & "_" _

                 & Format(Now, "yyyymmdd hh-mm")

            sFileName = sPath & aStr & ".pdf"

            Debug.Print sFileName

            SH.ExportAsFixedFormat _

                    Type:=xlTypePDF, _

                    Filename:=sFileName, _

                    Quality:=xlQualityStandard, _

                    IncludeDocProperties:=True, _

                    IgnorePrintAreas:=False, _

                    OpenAfterPublish:=False

        Next i

        Call MsgBox(Prompt:="Finito", _

                    Buttons:=vbInformation, _

                    Title:="Un altro giorno, un altro dollaro!")

    End Sub

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

    Public Function LastRow(SH As Worksheet, _

                            Optional Rng As Range)

        If Rng Is Nothing Then

            Set Rng = SH.Cells

        End If

        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

    End Function

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

    ===

    Regards,

    Norman

    0 commenti