openoffice-users-de mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Horst <technik_...@jrsch.de>
Subject Bilder in Tabelle per Makro
Date Tue, 23 Aug 2016 08:21:31 GMT
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: users-de-unsubscribe@openoffice.apache.org
For additional commands, e-mail: users-de-help@openoffice.apache.org


Mime
View raw message