inserisci in word

Attribute VB_Name = "inserisci_in_word"

'

Option Explicit

'

' vba - Excel to Word.

' attivare strumenti/riferimenti Microsoft Word Office Library

' i nomi presenti nella prima riga del foglio servono come chiavi di ricerca in Word.

' es. A1 = "indirizzo" in Word viene ricercata la parola: "%%indirizzo%%".

' in Word la parola "%%indirizzo%%" viene sostituita con il valore contenuto nella cella attiva del foglio Excel.

' la procedura cerca di inserire i valori di tutte le colonne.

'

'

Sub usocambiainword()

Dim nomefoglio As String, riga, nomedocumento As String, salvaconnome As String

nomefoglio = CStr(ActiveSheet.Name)

riga = ActiveCell.Row

nomedocumento = CStr("C:\dato.doc")

salvaconnome = CStr("C:\datosalvato.doc")

Call cambiainword(nomefoglio, riga, nomedocumento, salvaconnome)

'

End Sub

'

Sub cambiainword(nomefoglio As String, riga, nomedocumento As String, salvaconnome As String)

'

Dim appwd As Object, colkey As Integer, coldato As Integer

Dim tipodocWord

'

Set appwd = CreateObject("Word.Application")

appwd.Visible = True

' applicazione invisibile

' appwd.Visible = False

' ingrandisco la finestra

' appwd.WindowState = wdWindowStateMaximize

'

tipodocWord = Right(nomedocumento, 4)

If tipodocWord = ".dot" Then

' documento da modello .dot

appwd.Documents.Add nomedocumento

End If

If tipodocWord = ".doc" Then

' apro il documento

appwd.Documents.Open (nomedocumento)

End If

'

Dim parolachiave As String, testo As String, foglio

Dim quantecolonne, contacolonne

'

Set foglio = Sheets(nomefoglio)

'quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

quantecolonne = Range(foglio.UsedRange.Cells(1, foglio.UsedRange.Columns.Count).Address).Column

'

For contacolonne = 1 To quantecolonne

parolachiave = Trim(foglio.Cells(1, contacolonne))

testo = Trim(foglio.Cells(riga, contacolonne))

parolachiave = "%%" & parolachiave & "%%"



With appwd.ActiveDocument.Range.Find

.Text = parolachiave

.Replacement.Text = testo

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

.Execute Replace:=wdReplaceAll ' tutte le espressioni vengono sostituite.

End With

Next contacolonne

' stampo il documento

' appwd.ActiveDocument.PrintOut

' salvo il documento.

appwd.ActiveDocument.SaveAs salvaconnome

' visualizzo il documento

appwd.Visible = True

' finestra al massimo

appwd.WindowState = wdWindowStateMaximize

' attivo

appwd.Application.Activate

'

End Sub