Spesso mi è capitato di incontrare nei vari Forum una richiesta del tipo”Avendo un file di Excel , composto da un database con dei record,come faccio a compilare un modello di Word con i record del mio file di Excel,senza fare la stampa unione?”
Una soluzione molto semplice sta nel fatto di inserire nel file di Word dei segnaposto , formati da alcuni caratteri, che poi il codice che andremo ad inserire nel file di Excel li posso individuare e sovrascriverli con i dati prelevati dal nostro database.
Per prima cosa dobbiamo creare un file di Word con tutto quello che ci riguarda, e inserire all’interno di questo file dei segnaposto, che nel nostro caso saranno preceduti dal segno #. Avremo un file come quello in figura:
Salviamo il nostro file di Word, in una dir, dove poi andremo a salvare anche il nostro file di Excel, quindi , affinché il tutto funzioni, sia il file di Word che il file di Excel, debbono trovarsi nella stessa Dir.
Creiamo il nostro file di Excel,che abbia la struttura come quello in figura:
A questo punto , apriamo nel nostro file di Excel , l’editor di VBA e in un modulo inseriamo il codice postato:
Option Explicit
Private Sub Excelchiamaword2()
Dim Word As Word.Application
Dim DOC As Word.Document
Dim sPath As String, modulo As String, cognome As String
Dim nome1 As String
Dim conta As Integer, ultimariga As Integer, t As Integer
Dim rng As Range, cl As Range
Set Word = CreateObject("Word.Application")
Word.Visible = False 'True
sPath = ThisWorkbook.Path & "\"
modulo = "master"
ultimariga = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("a2:a" & ultimariga)
For Each cl In rng
Set DOC = Word.Documents.Open(sPath & modulo & ".docx")
'rendiamo false la visualizzazione per evitare fastidiosi apertura e chiusura di Word
Word.Visible = False
t = cl.Row
With DOC
.Application.Selection.Find.Execute FindText:="#citta", ReplaceWith:=Cells(t, 3), Replace:=wdReplaceAll
.Application.Selection.Find.Execute FindText:="#nome", ReplaceWith:=Cells(t, 1), Replace:=wdReplaceAll
.Application.Selection.Find.Execute FindText:="#cognome", ReplaceWith:=Cells(t, 2), Replace:=wdReplaceAll
.Application.Selection.Find.Execute FindText:="#data", ReplaceWith:=Cells(t, 4), Replace:=wdReplaceAll
.Application.Selection.Find.Execute FindText:="#paese", ReplaceWith:=Cells(t, 5), Replace:=wdReplaceAll
'assegniamo il Cognome
cognome = Cells(t, 2)
'se il file cognome.docx esiste
If Dir(sPath & cognome & ".docx") <> "" Then
' lo eliminiamo
Kill (sPath & cognome & ".docx")
End If
' lo salviamo
.SaveAs (sPath & cognome)
' questa ruotine per salvare il file in .Pdf
nome1 = (sPath & cognome & ".pdf")
If Dir(nome1) <> "" Then
nome1 = (sPath & cognome & ".pdf")
If Dir(nome1) <> "" Then
Kill (sPath & cognome & ".pdf")
End If
End If
.ExportAsFixedFormat OutputFileName:=nome1, ExportFormat:=wdExportFormatPDF
.Close
End With
Next
Set DOC = Nothing
Set Word = Nothing
End Sub
Lanciando il codice, avremo la compilazione del nostro documento Word, con tutti i campi dei record che compognono il nostro Database, che verra’ salvato in formato .docx e in formato .pdf
Ancora una volta: COMPLIMENTI.
Ciao,
Mario
Ottimo lavoro! Congratulazioni!
Ottimo !
Ricordo che avevo applicato questa tecnica in alcuni lavori per l’ufficio, riscontrando però il limite di 255 caratteri che “.Find.Execute Replace:=” non riusciva a gestire. Io avevo risolto all’epoca con una funzioncina che spezza il testo da inserire in chunk di massimo 255 caratteri. Nei prossimi giorni recupero il lavoro e lo posto come commento, per chi interessa 🙂
Ecco la funzioncina SearchAndReplace di cui parlavo.
Si utilizza come una normale sub:
SearchAndReplace “#nome”, “vecchio frac”
[code]
‘Execute Find & replace fallisce per sostituzioni di stringhe > 255 chars.
‘http://stackoverflow.com/questions/5050902/runtime-error-5854-string-parameter-is-too-long
Private Sub SearchAndReplace(search As String, replace As String)
Dim i As Integer, chunks As Integer, chunk As String
With ActiveDocument.Content.Find
.ClearFormatting
.MatchCase = True
.MatchWholeWord = True
‘ We get error 5854 if the replacement text is greater than 255 characters, so need to work around
‘ How many 250 character “chunks” are there in the replacement text?
chunks = Round(Len(replace) / 250, 0) ‘ Use 250 to allow for {1}, etc.
If Len(replace) Mod 250 > 0 Then chunks = chunks + 1 ‘ Workaround because there’s no Ceiling()
If chunks <= 1 Then .Execute FindText:=search, ReplaceWith:=replace, replace:=wdReplaceAll Else ' Replace existing replacement variable (e.g. {Text}) the first chunk's replacement variable (i.e. {1}) .Execute FindText:=search, ReplaceWith:="{1}", replace:=wdReplaceAll ' Replace the text in chunks of less than 255 characters For i = 1 To chunks ' Get the chunk = Mid(replace, ((i - 1) * 250) + 1, 250) ' Add the replacement variable for the next chunk to the end of the string If i < chunks Then chunk = chunk & "{" & (i + 1) & "}" .Execute FindText:="{" & i & "}", ReplaceWith:=chunk, replace:=wdReplaceAll Next i End If End With End Sub [/code]
Volendo utilizzare solo alcuni campi dei record, come si potrebbe modificare la macro?
ho provato a copiare sul mio foglio excel ma mi da questo errore
Word As Word.Application non definito dall’utente
vedi :
https://www.excelvba.it/forumexcel/excel-chiama-word/
se nel word ho la necessità di inserire uno stesso segnaposto in due diverse posizioni, come posso fare?
Ho notato che inserendo il secondo segnaposto il primo “scompare”, rendendone impossibile la compilazione.
esempio:
il sottoscritto “RefNome” …..
Firma “RefNome”
nel modello dell’esempio abbiamo due segnaposto #citta in due posizioni diverse e li scrive tranquillamente .
Come si apre l’editor di vba su excel?