Macro per copiare valori da celle Excel in segnalibri Word

Question

Giorno a tutti

mi domandavo se esisteva la possibilità di copiare dei valori (dati) da un foglio Excel ad un foglio Word già impostato con i segnalibri.

Ad esempio dovrei copiare:

dalla cella A1 al segnalibro NOME

dalla cella G2 al segnalibro PROGETTO

ecc....

Questa copia deve però essere fatta in base a 2 criteri.

questi 2 criteri si trovano nelle celle B53 e B57 del foglio1

I criteri consistono nell'individuare il documento word da aprire.

• criterio di B53 identifica la cartella base da aprire C:\Desktop\OFFERTE\

e come sotto cartelle ci sono SLIM \ ECO \ PRO (che sono le 3 possibili scritte che ci saranno in questa cella)

• criterio di B57 apre il file doc

che come nome base è Modulo_Offerta_*****.doc e al posto degli asterischi ci possono essere delle sigle tipo CBCM / CBLM ecc.

Chiedo cortesemente se qualcuno può indirizzarmi sulla via di questa operazione

Grazie mille

Answer 1

Si grazie Mauro sono riuscito a copiare i dati.

Però ho visto che salva in automatico.

A me servirebbe che mi salvasse il nome in un'altro modo così da lasciare il file doc originale così com'è.

Per quanto riguarda il fatto di utilizzare i criteri che ho descritto prima, riesci ad aiutarmi?

Ps: vai tranquillo...appena hai tempo

Grazie

Allora.....

Credo di averla modificata come richiesto(vedi la nota in fondo):

Public Sub m()

 On Error GoTo RigaErrore

    Dim objWord As Object

    Dim objDoc As Object

    Dim sPath As String

    Dim sNomeFile As String

    Dim sh As Worksheet

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    With sh

        sPath = .Range("B53").Value

        sNomeFile = .Range("B57").Value

        Set objWord = CreateObject("Word.Application")

        If Dir(sPath) <> "" Then

            Set objDoc = objWord.Documents.Open(sPath & sNomeFile)

            objDoc.Bookmarks("NOME").Range.Text = .Range("A1").Value

            objDoc.Bookmarks("PROGETTO").Range.Text = .Range("G2").Value

            'objWord.Visible = True

            objDoc.SaveAs (sPath & "tuoNome" & ".doc")

            objDoc.Close

            Set objDoc = Nothing

        End If

    End With

RigaChiusura:

    If Not objWord Is Nothing Then

        objWord.Quit

        Set objWord = Nothing

    End If

    Exit Sub

RigaErrore:

    MsgBox Err.Number & vbNewLine & Err.Description

    Resume RigaChiusura

 End Sub

NOTA.

Questa è la riga che salva il file:

objDoc.SaveAs (sPath & "tuoNome" & ".doc")

Io non so cosa vuoi metterci tu al posto di tuoNome, non l'hai scritto( o almeno io non lo leggo).

Fai sapere, grazie.

Answer 2

Ho iniziato a provare un po':

Public Sub m()

On Error GoTo RigaErrore

Dim objWord As Object

Dim objDoc As Object

Dim sPath1 As String

Dim sPath2 As String

Dim sNomeFile1 As String

Dim sNomeFile2 As String

Dim sh1 As Worksheet

Dim sh2 As Worksheet

Dim sh3 As Worksheet

Set sh1 = ThisWorkbook.Worksheets("Riepilogo")

Set sh2 = ThisWorkbook.Worksheets("QGL10.03b")

Set sh3 = ThisWorkbook.Worksheets("Ref")

With sh1

sPath2 = .Range("B53").Value

sNomeFile2 = .Range("B57").Value

sPath1 = "G:\OFFERTE\ITALIANO" & sPath2

sNomeFile1 = "Modulo_Offerta_" & sNomeFile2 & ".doc"

End With

With sh1

Set objWord = CreateObject("Word.Application")

If Dir(sPath2) <> "" Then

Set objDoc = objWord.Documents.Open(sPath1 & sNomeFile1)

'intestazione

objDoc.Bookmarks("DITTA").Range.Text = .Range("K3").Value

objDoc.Bookmarks("CA1").Range.Text = .Range("K4").Value

objDoc.Bookmarks("INDIRIZZO").Range.Text = .Range("K5").Value

objDoc.Bookmarks("CAP").Range.Text = .Range("K6").Value

objDoc.Bookmarks("COMUNE").Range.Text = .Range("K7").Value

objDoc.Bookmarks("PROVINCIA").Range.Text = .Range("K8").Value

'presentazione offerta

objDoc.Bookmarks("DATA1").Range.Text = .Range("G1").Value

objDoc.Bookmarks("CA2").Range.Text = .Range("K4").Value

objDoc.Bookmarks("PROGETTO").Range.Text = .Range("D2").Value

'dati calcolo

objDoc.Bookmarks("SUP2").Range.Text = .Range("C10").Value

objDoc.Bookmarks("ALONG").Range.Text = .Range("G20").Value

objDoc.Bookmarks("CORDOLI").Range.Text = .Range("G22").Value

objDoc.Bookmarks("ASUP").Range.Text = .Range("G32").Value

objDoc.Bookmarks("CLS").Range.Text = .Range("E16").Value

objDoc.Bookmarks("QCLS").Range.Text = .Range("E17").Value

'objWord.Visible = True

objDoc.SaveAs (sPath1 & "Offerta" & ".doc")

objDoc.Close

Set objDoc = Nothing

End If

End With

RigaChiusura:

If Not objWord Is Nothing Then

objWord.Quit

Set objWord = Nothing

End If

Exit Sub

RigaErrore:

MsgBox Err.Number & vbNewLine & Err.Description

Resume RigaChiusura

End Sub

Answer 3

Grazie Mauro per il codice.

Provo a spiegarti dove e come devo chiamare questo file word.

il file word si trova nella cartella:

G:\OFFERTE\ITALIANO\

ci sono 3 sottocartelle

ECO

PRO

SLIM

in base al 1° criterio situato nel foglio Riepilogo nella cella B53 il codice dovrebbe entrare in una delle 3 cartelle di cui sopra.

il base nome del file Word è così composto: (sono 7 files per ogni tipologia di cui sopra)

Modulo_offerta_CBCM.doc

Modulo_offerta_CBCM-C.doc

Modulo_offerta_CBLM.doc

Modulo_offerta_CBLM-C.doc

Modulo_offerta_CBLM_LU.doc

Modulo_offerta_CBLM_LO.doc

Modulo_offerta_CBCM_SP.doc

La sigla finale del file word (2° criterio) si trova nella cella B57 del foglio Riepilogo.

Il file CB-TECH si trova nella cartella:

U:\IT.12.XXXX\03-CALCOLO\02-XLS

il file Word deve essere salvato in:

U:\IT.12.XXXX\04-OFFERTE_CONTRATTO

Le XXXX della cartella sopra sono il numero del progetto su cui sto lavorando. Ovviamente gli do un numero progressivo ogni volta che ho un nuovo progetto.

Il nome con cui vorrei salvare il file word ad esempio è così composto:

Offerta_nr_33_12_8788_Copec Srl_del_08.03.2012.doc

-Offerta_nr  ==>base

-33  ==> cella     =QGL10.03b!H3

-12  ==> cella     =QGL10.03b!I3

-8788  ==> cella   =Riepilogo!D1

-Copec Srl  ==>  cella   =Riepilogo!K3

-del  ==>  base

-08.03.2012  ==>  data odierna

Non so se sono riuscito a spiegare. Fammi sapere se hai bisogno di altre info.

Grazie intanto

Answer 4

Si grazie Mauro sono riuscito a copiare i dati.

Però ho visto che salva in automatico.

A me servirebbe che mi salvasse il nome in un'altro modo così da lasciare il file doc originale così com'è.

Per quanto riguarda il fatto di utilizzare i criteri che ho descritto prima, riesci ad aiutarmi?

Ps: vai tranquillo...appena hai tempo

Grazie

Answer 5

Giorno a tutti

mi domandavo se esisteva la possibilità di copiare dei valori (dati) da un foglio Excel ad un foglio Word già impostato con i segnalibri.

Ad esempio dovrei copiare:

dalla cella A1 al segnalibro NOME

dalla cella G2 al segnalibro PROGETTO

ecc....

Questa copia deve però essere fatta in base a 2 criteri.

questi 2 criteri si trovano nelle celle B53 e B57 del foglio1

I criteri consistono nell'individuare il documento word da aprire.

• criterio di B53 identifica la cartella base da aprire C:\Desktop\OFFERTE\

e come sotto cartelle ci sono SLIM \ ECO \ PRO (che sono le 3 possibili scritte che ci saranno in questa cella)

• criterio di B57 apre il file doc

che come nome base è Modulo_Offerta_*****.doc e al posto degli asterischi ci possono essere delle sigle tipo CBCM / CBLM ecc.

Chiedo cortesemente se qualcuno può indirizzarmi sulla via di questa operazione

Grazie mille

Questo è codice che mi sebra di aver postato poco tempo fa e che dovrebbe far capire come è possibile fare quello che chiedi:

Public Sub m()

On Error GoTo RigaErrore

    Dim objWord As Object

    Dim objDoc As Object

    Dim sPath As String

    Dim sNomeFile As String

    Dim sh As Worksheet

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    sPath = "C:\Prova"

    sNomeFile = "mioDoc.docx"

    With sh

        Set objWord = CreateObject("Word.Application")

        If Dir(sPath) <> "" Then

            Set objDoc = objWord.Documents.Open(sPath & sNomeFile)

            objDoc.Bookmarks("Uno").Range.Text = .Range("A" & 1).Value

            objDoc.Bookmarks("Due").Range.Text = .Range("B" & 5).Value

            'objWord.Visible = True

            objDoc.Close

            Set objDoc = Nothing

        End If

    End With

RigaChiusura:

    If Not objWord Is Nothing Then

        objWord.Quit

        Set objWord = Nothing

    End If

    Exit Sub

RigaErrore:

    MsgBox Err.Number & vbNewLine & Err.Description

    Resume RigaChiusura

End Sub

Prova un po' e vedi se riesci.

NOTA. Per l'altra cosa appena posso, scusa.