Seite 1 von 1
Bild per Makro einfügen, skalieren und positionieren
Verfasst: Mi, 04.12.2013 21:33
von markus32
Hallo Openoffice-Freunde,
schlage mich schon seit paar Stunden rum und komme leider nicht weiter.
Hoffe Ihr könnt mir helfen.
Aufgabenstellung:
Habe eine Calc-Tabelle mir URLs von Bildern die auf meiner Festplatte sind (siehe Tabelle vorher bild).
Per Macro soll nun das Bild zu dem Link eingefügt werden. Die Höhe des Bilds soll bei gleichbleibendem Seitenverhältnis 5cm betragen.
Am Ende soll es dann so ausehen (siehe Bild Tabelle danach).
Frage:
wie man per Macro Bilder einfügt hab ich rausgefunden, aber wie kann ich festlegen, das als Quelle die eigene Tabelle verwendet wird fortlaufend?
Der Wert "Value" müsste dann immer der Pfad aus der Tabelle sein.
Code: Alles auswählen
dim args3(2) as new com.sun.star.beans.PropertyValue
args3(0).Name = "FileName"
args3(0).Value = "file://localhost/Volumes/Firma/001%20Bilder%20&%20Videos%20&%20PSD/Rohformate/Samsung_M8800_afsl_b.jpg"
args3(1).Name = "FilterName"
args3(1).Value = "JPEG - Joint Photographic Experts Group"
args3(2).Name = "AsLink"
args3(2).Value = false
dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args3())
Könnt Ihr mir helfen?
Gruß Markus
Re: Bild per Macro einfügen. Quelle in Tabelle
Verfasst: Mi, 04.12.2013 22:49
von F3K Total
Hi,
so sollte es für die Zellen A2 bis A5 gehen:
Code: Alles auswählen
Sub Main
dim args3(2) as new com.sun.star.beans.PropertyValue
osheet = thiscomponent.sheets.getbyname("Tabelle1")
oRange = osheet.getcellrangebyname("A2:A5")
for i = 0 to oRange.Rows.count - 1
ocell = oRange.getcellbyposition(0,i)
sUrl = converttourl(ocell.formula)
args3(0).Name = "FileName"
args3(0).Value = sUrl
args3(1).Name = "FilterName"
args3(1).Value = "JPEG - Joint Photographic Experts Group"
args3(2).Name = "AsLink"
args3(2).Value = false
... usw...
next i
End Sub
Gruß R
Re: Bild per Macro einfügen. Quelle in Tabelle
Verfasst: Do, 05.12.2013 01:41
von markus32
Hallo R,
danke für die schnelle Hilfe.
Es funktioniert soweit, das die Bilder eingefügt werden.
Frage:
1- Weisst du wie ich die Bilder skalieren kann auf einen festen Wert von 5cm höhe. Das Seitenverhältnis soll 1:1 bleiben.
2- Die Bilder sollen in der jeweiligen Zeile angezeigt werden. Aktuell sind alle Bilder ganz oben übereinander.
Vielen Dank
Markus
der Code sieht jetzt so aus
Code: Alles auswählen
Sub Main
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args3(2) as new com.sun.star.beans.PropertyValue
osheet = thiscomponent.sheets.getbyname("Tabelle1")
oRange = osheet.getcellrangebyname("A2:A5")
for i = 0 to oRange.Rows.count - 1
ocell = oRange.getcellbyposition(0,i)
sUrl = converttourl(ocell.formula)
args3(0).Name = "FileName"
args3(0).Value = sUrl
args3(1).Name = "FilterName"
args3(1).Value = "JPEG - Joint Photographic Experts Group"
args3(2).Name = "AsLink"
args3(2).Value = false
dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args3())
next i
End Sub
Re: Bild per Makro einfügen, skalieren und positionieren
Verfasst: Do, 05.12.2013 18:07
von F3K Total
So,
anbei zwei Makros, rufe das erste,
S_Find_cells, auf, dann werden die Bilder in der Größe, die du im Code eingestellt hast eingefügt und sogar benamst (Rechte Maus auf Bild -> Name)
Code: Alles auswählen
Sub S_Find_cells
dim nlength as integer
odoc = Thiscomponent
osheet = odoc.sheets.getbyname("Tabelle1")
oPage = osheet.drawpage
oRange = osheet.getcellrangebyname("A2:A6")'<------ Spalte mit Hyperlinks
for i = 0 to oRange.Rows.count - 1
ocell = oRange.getcellbyposition(0,i)
sUrl = converttourl(ocell.formula)
if sUrl = "" then goto 100
nlength = len(sUrl)
for k = 1 to nlength - 1
if mid(sUrl,nlength-k,1) = "." then
nExtension = nlength - k
endif
if mid(sUrl,nlength - k,1) = "/" then
nBackslash = nlength-k
exit for
endif
next k
sGrafikname = mid(sUrl,nBackslash + 1, nExtension-nBackslash-1)
insertgrafik(opage,ocell,surl,odoc,sgrafikname)
100:
next i
end sub
Sub insertgrafik(opage,ocell,urlgrafik,odoc,grafikname)
Dim Size As New com.sun.star.awt.Size
Dim Size_max As New com.sun.star.awt.Size
oGrafik = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
oGrafik.GraphicURL = urlgrafik
oGrafik.name = grafikname
'Ankerposition festlegen
opage.add(oGrafik)
oGrafik.Anchor = oCell
Size_max.width = 7000'<------ max. Bildbreite
Size_max.height = 5000'<------ max. Bildhöhe
new_Original_Size = oGrafik.Graphic.SizePixel
Factor_Width=Size_max.width/new_Original_Size.width
Factor_Height=Size_max.Height/new_Original_Size.Height
if Factor_Width<=Factor_Height then
factor=Factor_Width
else
factor=Factor_Height
endif
size.width = new_Original_Size.width*factor
size.Height = new_Original_Size.Height*factor
oGrafik.setSize(size)
End Sub
Gruß R