Newsgroup: it.comp.appl.access
Titolo: integrazione access word - ridurre immagini

buongiorno,
 
con il seguente script inserisco delle immagini in due tabelle di un 
documento, tuttavia altune immagini hanno dimensioni spropositate e 
vorrei ridurle ad un quadrato di lato massimo 2.5cm. Ho gia provato ad 
estrarre in codice da word ma non ha funzionato, il vba word restituisce 
solo moveup o movedown per la selezione della immagine. Suggerimenti?
 
Dim Wrd As Word.Application
Dim Doc As Word.Document
Dim tbl As Word.Table
 
Dim pic, tipo As String
 
 
GetDBPath = CurrentProject.Path 'nome percorso
 
 
CreateObject ("Word.Application")
On Error Resume Next 'gestione errori step by step 'cerca un'istanza di 
Word già aperta
Set Wrd = GetObject(, "Word.Application")
If Err.Number = 429 Then 'se c'è stato un errore è perchè Word non era 
già aperto: 'aprilo adesso
Set Wrd = CreateObject("Word.Application")
End If
On Error GoTo 0 'ripristina la segnalazione degli errori
 
Wrd.Visible = True
Wrd.Activate
 
Set Doc = Wrd.Documents.Add(CurrentProject.Path & 
"/ripre.mod.seges.docx")  'nuovo doc
 
....
Doc.Bookmarks("n_ambiente").Select
Wrd.Selection.TypeText Me.SIT
....
 
' da questo punto inserisco le immagini
 
Me![segnaleticaLAB].SetFocus
DoCmd.GoToRecord , , acFirst
 
i = 0 'contatore obblighi
j = 0 'contatore avvertimenti e divieti
 
Do While IsNull(Forms!gestione_locale![segnaleticaLAB]!tipo) = False
 
tipo = Forms!gestione_locale![segnaleticaLAB]!tipo
 
If tipo = "obbligo" Then
 
     pic = DLookup("[indirizzo file]", "seges", "[nome segnale]=""" & 
Me![segnaleticaLAB]![segnale] & """")
 
     If j < 6 Then
     ActiveDocument.Shapes("Rettangolo arrotondato 82").Select
     With Selection.Tables(1)
        .Cell(1, j + 1).Select
     End With
     Wrd.Selection.TypeText " "
     Wrd.Selection.InlineShapes.AddPicture pic
 
     Wrd.Selection.TypeText Chr(13) & Me![segnaleticaLAB]!segnale
 
     j = j + 1
     ElseIf j >= 6 Then
     MsgBox "hai raggiunto il massimo numero di obblighi!"
     End If
 
Else
 
     pic = DLookup("[indirizzo file]", "seges", "[nome segnale]=""" & 
Me![segnaleticaLAB]!segnale & """")
 
     If i < 6 Then
     ActiveDocument.Shapes("Rettangolo arrotondato 11").Select
     With Selection.Tables(1)
        .Cell(1, i + 1).Select
     End With
     Wrd.Selection.TypeText " "
     Wrd.Selection.InlineShapes.AddPicture pic
 
     Wrd.Selection.TypeText Chr(13) & Me![segnaleticaLAB]!segnale
 
     i = i + 1
 
     ElseIf i >= 6 And i < 12 Then
     ActiveDocument.Shapes("Rettangolo arrotondato 11").Select
     With Selection.Tables(1)
        .Cell(2, i - 5).Select
     End With
     Wrd.Selection.TypeText " "
     Wrd.Selection.InlineShapes.AddPicture pic
 
     Wrd.Selection.TypeText Chr(13) & Me![segnaleticaLAB]!segnale
 
     i = i + 1
     ElseIf i >= 12 And i < 18 Then
     ActiveDocument.Shapes("Rettangolo arrotondato 11").Select
     With Selection.Tables(1)
        .Cell(3, i - 11).Select
     End With
     Wrd.Selection.TypeText " "
     Wrd.Selection.InlineShapes.AddPicture pic
 
     Wrd.Selection.TypeText Chr(13) & Me![segnaleticaLAB]!segnale
     i = i + 1
 
     End If
 
 
End If
 
DoCmd.GoToRecord , , acNext
 
Loop
 
'Error 11
 
new_modello = GetDBPath & "\segnaletica\" & Me.COEDI & " - " & Me.SIT & 
" - " & Me.Laboratorio & ".docx"
ActiveDocument.SaveAs2 (new_modello)
 
'Doc.Close
 
Set Doc = Nothing
Set Wrd = Nothing
'Wrd.Quit
 
 
grazie


con questo codice io inserisco immagini in word impostando il lato corto 
e ridimensionando quello lungo di conseguenza
 
vedi se fattibile adattarlo al tuo caso
 
 
 
  Dim objWordApp As Object
     Dim objDoc As Object
     Dim objInlineShape As Object
 
 
     Set objWordApp = CreateObject("Word.Application")
 
 
     Set objDoc = objWordApp.Documents.Add
 
     Dim imagePath As String
     imagePath = "C:\Immagine.jpg"
 
     Set objInlineShape = 
objDoc.InlineShapes.AddPicture(FileName:=imagePath, LinkToFile:=False, 
SaveWithDocument:=True)
 
     ' Ridimensiona l'immagine con lato corto a 100
     Dim newWidth As Single
     Dim newHeight As Single
     Dim shortSideLength As Single
 
     shortSideLength = 100
 
 
     newWidth = objInlineShape.Width * shortSideLength / 
objInlineShape.Height
     newHeight = shortSideLength
 
     objInlineShape.LockAspectRatio = False
     objInlineShape.Width = newWidth
     objInlineShape.Height = newHeight
 
 
     objWordApp.Visible = True
 
 
     Set objInlineShape = Nothing
     Set objDoc = Nothing
     Set objWordApp = Nothing
 
 
BFS


Funziona ma mi cancella la tabella, credo che la mia difficoltà stia nel 
fatto che devo far capire ad access che l'immagine da manipolare sia in 
una tabella che a sua volta sta in una forma.
 
a questo punto non so se sia meglio ridurre l'immagime man mano che sono 
inserite o fare tutto a documento pronto, il primo caso, a pelle, 
dovrebbe essere più facile mentre nel secondo devo fare una ricerca di 
tutte le immagini saltando quelle che sono i contorni delle tabelle.
 
grazie
 
Grazie


potresti usare i segnalibri per far capire esattamente ad access dove 
posizionarsi per inserire la foto
 
 
 
BFS
 
 
 
 


ha funzionato e sono riuscito a ciclarla, però ora vorrei impostare le 
dimensioni in cm invece che pixel, si può fare?
 
 


tutto ok, ho fatto il conto a mano e ricavato i pixel necessari per la 
corretta centratura.
la porzione di codice aggiunta al ciclo e la seguente
 
Set immSegnale = Wrd.Selection.InlineShapes.AddPicture(FileName:=pic, 
linktofile:=False, savewithdocument:=True)
     immSegnale.Width = 60
     immSegnale.Height = 60
 
ancora grazie per il supporto