Automatizzare immagini da Access a Word

Question

Ciao,

in Tabella1 ho due campi "Nominativo" e "Foto" con tipo dati, rispettivamente: Testo e Allegato.

Con la seguente automazione, invio i dati in un modulo di Word:                                    

Dim Wrd As Object, Doc As Object

Dim rst As DAO.Recordset

Dim Modello As String, NomeFile As String, i As Integer

Dim Record As String, sql As String

Dim Tbl As String * 1

Dim TotRiga As Currency, Totale As Currency

Dim ReplSel As Boolean

Dim oWordTab As Object

    Modello = CurrentDb.Name

    Modello = Left(Modello, Len(Modello) - Len(Dir(Modello))) & "Anteprima_Comunicato.dot"

    On Error Resume Next

    Set Wrd = GetObject(, "Word.Application")

    If Err.Number = 429 Then

        Set Wrd = CreateObject("Word.Application")

    End If

    On Error GoTo 0

    Wrd.Visible = True

    Wrd.Activate

    ReplSel = Wrd.Options.ReplaceSelection

    Wrd.Options.ReplaceSelection = True

    Set Doc = Wrd.Documents.Add(Modello)

    Doc.Activate

    Doc.Bookmarks("Risultati").Select

        sql = "SELECT * FROM Tabella1;"

    Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)

        Tbl = Chr$(9)

        With rst

            Totale = 0 '

            .MoveFirst

            While Not .EOF

                Record = !Nominativo & Tbl & _

                         !Foto

                Wrd.Selection.TypeText Record & vbCrLf

                Totale = Totale + TotRiga

                .MoveNext

            Wend

        End With

        rst.Close: Set rst = Nothing

    Wrd.Options.ReplaceSelection = ReplSel

    Wrd.Application.WordBasic.MsgBox "Esportazione terminata", "Esportazione dati da Access"

    Set Doc = Nothing

    Set Wrd = Nothing

Il problema è che ho l'errore "Tipo non corrispondente" per il campo Foto.

Anche servendomi dell'esportazione presente nella barra multifunzione, il percorso e di conseguenza l'immagine non viene riconosciuta.

Vladimiro

Answer 1

ciao  Vladimiro,

ho usato un mio percorso per la memorizzazione dei files, word2 è una cartella del percorso.

ho ipotizzato immagini ad hoc, se non lo  sono è ncessario ridurre le dimensioni.

prova così :  link

Ciao, Sandro

Answer 2

ciao Vladimiro,

ho modificato qualcosa sulle tabulazioni, le queries che generano il recordset ed inserito le immagini prima del nome della squadra qui : dbmodificato.

HTH.

ciao, Sandro.

Answer 3

ciao Vladimiro,

opterei per la memorizzazione delle immagini in un semplice campo testo al posto del campo allegato.

Ho provato a modifcare il codice inserendo l'oggetto shape per gestire l'immagine da unire a word, il salvataggio del file .doc 

 Dim Modello As String, NomeFile As String, i As Integer  '<--- non mi sembra siano utilizzato se così puoi eliminarle

Ciao Sandro,

ho cercato di semplificare al massimo l'esempio postato derivante da un'automazione molto più complessa e qualcosa mi è sfuggito, come le suddette  dichiarazioni che non ho cancellato.

Ho provato ad adattare il tuo esempio per vedere se ne potevo trarre spunto, ma non ci sono riuscito.

Quello che a me in realtà serve, è l'aggiunta del logo a fianco di ogni singola squadra nel rigo riguardante il risultato:

LOGOsquadra_A    LOGOsquadra_B          2   1

1 rete: pippo (Squadra_A)

1 rete: pluto (Squadra_A)

1 rete: paperino (Squadra_B)

Ammonito: Caio(Squadra_B)

LOGO squadra_C    LOGOsquadra_D ****       1  3

1 rete ecc........

Che ne pensi?

Vladimiro

Ciao Sandro,

al seguente link ho inserito un database di esempio.

Vladimiro

Answer 4

ciao Vladimiro,

opterei per la memorizzazione delle immagini in un semplice campo testo al posto del campo allegato.

Ho provato a modifcare il codice inserendo l'oggetto shape per gestire l'immagine da unire a word, il salvataggio del file .doc 

 Dim Modello As String, NomeFile As String, i As Integer  '<--- non mi sembra siano utilizzato se così puoi eliminarle

Ciao Sandro,

ho cercato di semplificare al massimo l'esempio postato derivante da un'automazione molto più complessa e qualcosa mi è sfuggito, come le suddette  dichiarazioni che non ho cancellato.

Ho provato ad adattare il tuo esempio per vedere se ne potevo trarre spunto, ma non ci sono riuscito.

Quello che a me in realtà serve, è l'aggiunta del logo a fianco di ogni singola squadra nel rigo riguardante il risultato:

LOGOsquadra_A    LOGOsquadra_B          2   1

1 rete: pippo (Squadra_A)

1 rete: pluto (Squadra_A)

1 rete: paperino (Squadra_B)

Ammonito: Caio(Squadra_B)

LOGO squadra_C    LOGOsquadra_D ****       1  3

1 rete ecc........

Che ne pensi?

Vladimiro

Answer 5

ciao Vladimiro,

opterei per la memorizzazione delle immagini in un semplice campo testo al posto del campo allegato.

Ho provato a modifcare il codice inserendo l'oggetto shape per gestire l'immagine da unire a word, il salvataggio del file .doc ad ogni loop con il nome contenuto nel campo nominativo in una sottocartella figlia della cartella che contiene il db. Creala se vuoi utilizzare la stessa modalità.

FullPath è il nome dell'immagine  ottenuto concatenando in una query il path dell'immagine con il suo nome estratto dal componente filename ( select.... , "C:\pathImmagini" & [foto].[FileName] AS fullPath from...).

Nei miei test ho eliminato il calcolo del totale...ripristinalo nel tuo scenario.

Facci sapere.

ciao, Sandro.

 Dim Wrd As Object, Doc As Object

 Dim rst As DAO.Recordset

 Dim Modello As String, NomeFile As String, i As Integer  '<--- non mi sembra siano utilizzato se così puoi eliminarle

 Dim Record As String, sql As String

 Dim Tbl As String * 1

 Dim TotRiga As Currency, Totale As Currency

 Dim ReplSel As Boolean

 Dim oWordTab As Object '<--- non mi sembra sia utilizzato se così puoi eliminarlo

Dim WdShape       As Object 'Shape

     Modello = CurrentDb.Name

     Modello = Left(Modello, Len(Modello) - Len(Dir(Modello))) & "Anteprima_Comunicato.dot"

     On Error Resume Next

     Set Wrd = GetObject(, "Word.Application")

     If Err.Number = 429 Then

         Set Wrd = CreateObject("Word.Application")

     End If

     On Error GoTo 0

     Wrd.Visible = True

     Wrd.Activate

     ReplSel = Wrd.Options.ReplaceSelection

     Wrd.Options.ReplaceSelection = True

     'Set Doc = Wrd.Documents.Add(Modello)

     'Doc.Activate

     'Doc.Bookmarks("bknome").Select

     sql = "SELECT * FROM query1;"  ' modificato in una query per estrarre il nome del file

     Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)

         Tbl = Chr$(9)

         With rst

             Totale = 0 '

             .MoveFirst

             While Not .EOF

                Set Doc = Wrd.Documents.Add(Modello)

                Doc.Activate

               ' Doc.Bookmarks("bknome").Select

                'Record = !Nominativo & Tbl & _

                          !Foto

                 'Wrd.Selection.TypeText bknome & vbCrLf

                 'Totale = Totale + TotRiga

                  With Doc

                       .Bookmarks("Risultati").Range.insertAfter rst.Fields("Nominativo ")

                        On Error Resume Next   ' nel caso in cui l'immagine non sia presente bypassiamo l'errore

                        Set WdShape = Doc.Shapes.AddPicture(FileName:=rst.Fields("fullPath"), Anchor:=Doc.Range)

                        With WdShape

                             .WrapFormat.Type = 0 ' wdWrapSquare

                             .Left = Wrd.InchesToPoints(3)

                             .LockAnchor = True

                        End With

                        On Error GoTo 0        ' rispristino la gestione degli errori

                        .SaveAs FileName:=CurrentProject.Path & "\doc" & rst.Fields("Nominativo") & ".doc", _

                                        FileFormat:=0, _

                                        AddToRecentFiles:=False

                                       .Close SaveChanges:=False

                   End With

                  .MoveNext

               Wend

         End With

         rst.Close: Set rst = Nothing

     Wrd.Options.ReplaceSelection = ReplSel    

    Set WdShape = Nothing

     Set Doc = Nothing

     Wrd.Quit

     Set Wrd = Nothing

 VBA.MsgBox "esportazione terminata", , "Esportazione dati da Access"