Ono to až tak složité není. Obrázek je potřeba umístit do buňky pomocí dispatcheru a následně upravit velikost pomocí DrawPage. Narychlo jsem splodil makro, ale v případě použití je potřeba tam zadat do cyklu FOR od jakého řádku po jaký se to má provést. Tak je to takové méně komfortní.
EDIT: upravil jsem to na otevřený cyklus, omezený počtem po sobě jdoucích prázdných buněk, takže for zmizelo.
sub CreateImage
'insert the image in the cell and resize
dim oDoc as object, oDocFrame as object
dim oDrawPage as object, oDrawPageObj as object
dim dispatcher as object
dim velikost as New com.sun.star.awt.Size
dim pozice as New com.sun.star.awt.Point
dim args1(3) as new com.sun.star.beans.PropertyValue
dim args2(0) as new com.sun.star.beans.PropertyValue
dim i as integer
oDoc = ThisComponent
oDocFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
list = oDoc.CurrentController.getActiveSheet()
oDrawPage = list.DrawPage
prazdne = 0
i = inputbox("Od jakého řádku mám začít? Zadej číslo řádku.","Zadej první řádek s adresou",2)
Do While prazdne < 5
'cyklus poběží dokud nenarazí na čtyři prázdné buňky po sobě
pozice1 = "A"& i
pozice2 = "B"& i
text_kodu = list.GetCellRangeByName(pozice2).String
'načtení URL - předpokládá se že je to již ve správné podobě
if text_kodu <> "" then 'prázdnou buňku přeskočíme
args2(0).Name = "ToPoint"
args2(0).Value = pozice1
dispatcher.executeDispatch(oDocFrame, ".uno:GoToCell", "", 0, args2())
args1(0).Name = "FileName"
args1(0).Value = text_kodu
args1(1).Name = "FilterName"
args1(1).Value = "<All formats>"
args1(2).Name = "AsLink"
args1(2).Value = false
args1(3).Name = "Style"
args1(3).Value = "TMsigFrame"
dispatcher.executeDispatch(oDocFrame, ".uno:InsertGraphic", "", 0, args1())
'načte poslední vložený obrázek
oDrawPageObj = oDrawPage.getByIndex(oDrawPage.Count - 1)
'úprava velikosti
vyska_radku = list.rows(i-1).Height - 100 'setin milimetru - volitelná hodnota zmenšení obrázku
velikost = oDrawPageObj.getSize()
velikost.width = velikost.width * vyska_radku / velikost.height 'setin milimetru
velikost.height = vyska_radku 'setin milimetru
oDrawPageObj.setsize(velikost)
'úprava pozice
sirka_sloupce = list.columns(0).Width 'setin milimetru
pozice = oDrawPageObj.getPosition()
' pozice.X = pozice.X + 1000 'setin milimetru - volitelná hodnota levého odsazení - zvolit pro umístění vlevo
pozice.X = pozice.X + (sirka_sloupce - velikost.width) - 1000 'setin milimetru - volitelná hodnota pravého odsazení - zvolit pro umístění vpravo
' pozice.X = pozice.X + (sirka_sloupce - velikost.width) / 2 'zvolit pro případ umístění na střed
pozice.Y = pozice.Y + 50 'setin milimetru - volitelná hodnota horního odsazení
oDrawPageObj.setposition(pozice)
prazdne = 0
else
prazdne = prazdne + 1
end if
i = i + 1
Loop
end sub
Ještě by se v tomto případě mohlo hodit i makro na mazání všech obrázků. Když by se totiž URL změnila, tak makro vygeneruje obrázky znova, na oko to bude vypadat robře, ale ve skutečnosti se tam obrázky na sebe štosují. Takže je lepší nejdříve vše vymazat a potom obrázky znovu generovat.
Sub Clean
REM PROGRAM SMAŽE VŠECHNY OBRÁZKY KROMĚ VYJMENOVANÝCH A OVLÁDACÍCH PRVKŮ
oSheet = ThisComponent.CurrentController.getActiveSheet()
oDP = oSheet.DrawPage
for i = oDP.Count - 1 to 0 step -1
oObj = oDP.getByIndex(i)
TextString = oObj.getname
If TextString <> "logo1" Then 'zde zadejte název obrázku který chcete zachovávat
If TextString <> "logo2" Then 'zde zadejte název obrázku který chcete zachovávat, podmínky lze dále štosovat
If Not oObj.supportsService("com.sun.star.drawing.ControlShape") Then 'tato podmínka zachová ovládací prvky
oDP.remove(oObj) 'smaž obrázek
End If
End If
End If
next i
End sub
Editoval ludviktrnka (8. 4. 2017 09:42:49)
