Hallo,
ich habe einen Ordner mit Bildern und möchte diese Bilder in eine
Tabelle einfügen.
Dazu kommt der Dateiname und die Beschriftung.
Das ganze soll nach Afrika geschickt werden für die Beschriftung. Die
Datei muss daher letztendlich klein und ein doc Format haben.
Ich habe einige Schnipsel zusammengebaut, das funktioniert auch, aber
die Bilder verrutschen immer nach oben.
hat jemand eine besseres Codeschnipsel oder kann mir sagen wie man das
anpassen kann?
Horst
Hier mein Makro. (Ist nicht optimiert und vielleicht auch umständlich )
REM ***** BASIC *****
Sub Main
'init
holeDateinamen
S_Find_cells
End Sub
Sub holeDateinamen
zeile=1
'init
rem oDoc = StarDesktop.getCurrentComponent()
oDoc = ThisComponent
osheetTabelle1= oDoc.Sheets().getByName("Tabelle1")
REM zeigt alle Dateien und die Verzeichnisse
Dim sPath As String
Dim sDir as String, sValue as String
REM Pfad Anpassen
sPath = "C:\Users\ho\Documents\@Tandandale\Julienne"
sValue = Dir$(sPath + getPathSeparator + "*",0)
Do
If sValue <> "." and sValue <> ".." and sValue <> "" Then
if ucase(right(svalue,3))="JPG" then
osheetTabelle1.getcellbyposition(0,zeile).string=sPath +
getPathSeparator + svalue
osheetTabelle1.getcellbyposition(1,zeile).string= svalue
zeile=zeile+1
End If
End If
sValue = Dir$
Loop Until sValue = ""
End sub
Sub S_Find_cells
dim nlength as integer
odoc = Thiscomponent
osheet = odoc.sheets.getbyname("Tabelle1")
oPage = osheet.drawpage
oRange = osheet.getcellrangebyname("A2:A600")'<------ Spalte mit
Hyperlinks
for i = 0 to oRange.Rows.count - 1
ocell = oRange.getcellbyposition(0,i)
sUrl = converttourl(ocell.formula)
ocell.string=""
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
oDoc.CurrentController.select(ocell)
Zeilenhoehe
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 = 2100'<------ max. Bildbreite
Size_max.height = 1500'<------ 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
sub Zeilenhoehe
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")
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "RowHeight"
args1(0).Value = 1500
dispatcher.executeDispatch(document, ".uno:RowHeight", "", 0, args1())
end sub
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
