integrazione access word - ridurre immagini

[Akery]

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

[BFS]

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

[Akery]

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

[BFS]

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



BFS

[Akery]

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

[Akery]

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