Buonasera,
tempo fa ho chiesto aiuto in un altro forum (che adesso è chiuso) per creare un file di calc che avesse queste caratteristiche:
1- richiamare delle immagini in una determinata cella (e cancellazione dell’immagine precedente) a secondo del valore presente in un’altra cella;
2- ripetizione delle immagini fino al foglio n.5;
3- impostazione delle immagini sullo sfondo del livello.
Ho windows 10 e utilizzo libreoffice 5.2.3.3
Ho perso purtroppo il file che utilizzavo e adesso sto provando a ricrearlo ma mi da sempre degli errori e non essendo pratico di VBA non so come risolvere il problema.
Non posso allegare il file perché non ho ancora 3 punti di feedback.
Questa comunque è la macro che inserivo nel foglio:
Sub Immagine1(Target)
Dim Sh As Object, addr As Object
Dim Doc As Object
Dim Drw As Object, Image As Object, Gp As Object
Dim positionImage As New com.sun.star.awt.Point
Dim props( As New com.sun.star.beans.PropertyValue
Doc = ThisComponent
fpath = left(Doc.geturl(),revinstr(Doc.geturl(),"/"))
Sh = Target.getSpreadsheet()
oCellT() = Split(Target.AbsoluteName, “.”)
oCellTarget = oCellT(1)
If oCellTarget = “$A$37” Or oCellTarget = “$C$37” Then
If oCellTarget = “$A$37” Then
ITarget = sh.getCellRangeByName(“A15”) ’ serve per le coordinate di inserimento dell’immagine
oCell = “$A$15”
ElseIf oCellTarget = “$C$37” Then
ITarget = sh.getCellRangeByName(“D37”) ’ serve per le coordinate di inserimento dell’immagine
oCell = “$D$37”
End If
NomeImage = Target.String
For s = 0 To 4
Gp = createUnoservice(“com.sun.star.graphic.GraphicProvider”)
props(.Name = “URL”
props(.Value = fpath & NomeImage & “.jpg”
Image=Doc.createInstance(“com.sun.star.drawing.GraphicObjectShape”)
Image.Graphic = Gp.queryGraphic( props() )
’ Controllo se è presente l’immagine in archivio
If IsNull(Image.Graphic) Then MsgBox “Immagine non presente in archivio” : exit sub
’ Elimino se presente immagine precedente nella cella di destinazione
Drw = Doc.Sheets(.DrawPage
For i = 0 To Drw.Count - 1
CellaImmagine() = Split(Drw(i).Anchor.AbsoluteName, “.”)
If CellaImmagine(1) = oCell Then
Drw.Remove(Drw(i))
Exit For
End If
Next i
’ Aggiungo l’immagine
Drw.add(Image)
’ Ridimensiono l’immagine
Larg = 5000
resizeImageByWidth(Image,Larg)
positionImage.x = ITarget.position.x
positionImage.y = ITarget.position.y
Image.Position = positionImage
Image.Name = NomeImage
Image.Anchor = Doc.Sheets(<img src="http://it.libreofficeforum.org/sites/all/modules/smileys/packs/Roving/drunk.png" title="Drunk" alt="Drunk" class="smiley-content"/>.getCellRangeByName(oCell) 'ancoraggio alla cella
Image.LayerId = 1 'imposta l'immagine sullo sfondo
Next s
End if
End Sub
Sub resizeImageByWidth(ImageCmp As Object, Larg As Long)
Dim imageInfo As Object, Proporzione As Double, SizeImage As Object
imageInfo = ImageCmp.Graphic
SizeImage = imageInfo.SizePixel
Proporzione = SizeImage.Height / SizeImage.Width
SizeImage.Width = Larg
SizeImage.Height = SizeImage.Width * Proporzione
ImageCmp.Size = SizeImage
End Sub
function revinstr(s as string, slash as string) as string
dim ii as integer
ii=0
do
if instr(ii+1,s,slash)=0 then exit do
ii=instr(ii+1,s,slash)
loop
revinstr = ii
end function
C’è qualcuno che può aiutarmi?
Grazie
Giosi