[gelöst]Bild einfügen und größe prozentual ändern

[DAP]

Hallo,

ich würde gern per macro mehrere Bilder aus einem Verzeichnis in ein Writer-Document einfügen
und die Einfügegröße proportional zur Bildgröße z.B. auf 25 % stellen. Da ich von VBA komme,
kenne ich mich leider nicht so aus mit LO.

Ich hoffe es kann mir einer von Euch weiterhelfen.

Gruß DAP

[DAP]

gibt es keinen, der sich mit dem Thema auskennt?

[Frieder]

Hallo

gibt es keinen, der sich mit dem Thema auskennt?

Doch ich kenne mich damit aus, habe aber leider heute und morgen keine Zeit.
Du kannst deine Frage aber auch hier: http://de.openoffice.info/viewforum.php?f=18
wiederholen.

Bei openoffice.info gibt es mehr Leute, somit steigt die Wahrscheinlichkeit, das jemand auch Zeit hat.
Setzt dann aber bitte Links zu dem jeweiligen anderen Thema, damit jeder weiß, dass du auf 2 Foren nachgefragt hast.

Gruß Frieder

[DAP]

Hallo Frieder,

es ist nicht so dringlich bei mir, dann warte ich erst mal 2-3 Tage. Wenn ich ich dann
noch Fragen habe, kann ich immernoch ins anderer Forum gehen.

Gruß DAP

[Frieder]

Hallo DAP,

es tut mir leid, das ich die Letzte Woche nicht dazu gekommen bin dir zu helfen.
Aber jetzt habe ich Zeit, und kann dir Helfen.
Ich habe als Grundlage zu meinem Code 2 Funktionen von Andrew Pitonyaks
Buch "OpenOffice.org Macros Explained" aus Kapitel 14.3 verwendet.
(ich habe eigentlich nur die Änderung der Größe in % ergänzt.)

Der Code fügt an der aktuellen Curser-Position das Bild ein.
Du musst nur im Sub "InsertGraphicTest" den Pfad, und die Prozente eintragen.

Code: Alles auswählen

REM  *****  BASIC  *****

'Bitte Pfad und Größe in % anpassen.
Sub InsertGraphicTest
dim oDoc As Object, oCurs As Object
dim sPath$, sURL$, sParStyle$
Dim fprozent As Single 
'Der Pfad zum Bild
  sPath = "C:\Users\UserName\Pictures\MeinBild.png" 'Pfad zum Bild bitte anpassen.
'Umwandeln des Pfades in URL-Schreibweise.
  sURL = ConvertToUrl(sPath)
  oDoc = thisComponent 'das Dokument
  oCurs = oDoc.CurrentController.getViewCursor 'Die Aktuelle Curser-Position. Hier wird ds Bild eingefügt.
  sParStyle="Standard" ' Name der Absatzvorlage
  fprozent = 25 'Prozent von der originalgröße. Bitte anpassen
'Überprüfen, ob der Pfad existiert
  If FileExists(sPath) Then
     EmbedGraphic(oDoc, oCurs, sURL, sParStyle ,fprozent) 'Bild einfügen
  else
    MsgBox "Der angegebene Pfad zum Bild:" & Chr(10)& sPath & Chr(10)& _
           "existiert nicht.",16,"Fehler"  
  End if
End sub
'------------------------------------------------------------------------------
' oDoc – Dokument, das das Bild enthalten soll.
' oCurs – Cursor, wo das Bild eingefügt werden soll.
' sURL – URL des einzufügenden Bildes.
' sParStyle – Absatzvorlage für die Einfügestelle.
' fprozent - Größe des Bildes in % der Originalgröße
Sub EmbedGraphic(oDoc, oCurs, sURL$, sParStyle$, fprozent)
  Dim oShape
  Dim oGraph     'Das Grafikobjekt ist Textcontent.
  Dim oProvider  'Der Service GraphicProvider.
  Dim oText

  oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
  oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")

  oDoc.getDrawPage().add(oShape)

  oProvider = createUnoService("com.sun.star.graphic.GraphicProvider")

  Dim oProps(0) as new com.sun.star.beans.PropertyValue
  oProps(0).Name  = "URL"
  oProps(0).Value = sURL

  REM Sichert die Originalgröße.
  Dim oSize100thMM
  Dim lHeight As Long
  Dim lWidth As Long
  oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps))
  If NOT IsNull(oSize100thMM) AND NOT IsEmpty(oSize100thMM) Then
    lHeight = oSize100thMM.Height
    lWidth = oSize100thMM.Width
  End If

  oShape.Graphic = oProvider.queryGraphic(oProps())
  oGraph.graphicurl = oShape.graphicurl
  oGraph.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
  oText= oCurs.getText()
  oText.insertTextContent(oCurs, oGraph, false)
  oDoc.getDrawPage().remove(oShape)

  If lHeight > 0 AND lWidth > 0 Then
    Dim oSize
    oSize = oGraph.Size
    oSize.Height = lHeight * fprozent/100
    oSize.Width = lWidth  * fprozent/100
    oGraph.Size = oSize
  End If
  
  ' Setzt das Absatzformat, wenn es im Dokument existiert.
  Dim oStyles
  oStyles = oDoc.StyleFamilies.getByName("ParagraphStyles")
  If oStyles.hasByName(sParStyle) Then
    oCurs.ParaStyleName = sParStyle
  End If
End Sub
'-------------------------------------------------------------------------
'Ermittelt die originalgröße des Bildes.
'Dies ist notwendig, da sonst das Bild ca 0,5cm * 0,5cm groß eingefügt wird.
Function RecommendGraphSize(oGraph)
  Dim oSize
  Dim lMaxW As Double  ' Maximale Breite in 1/100 mm
  Dim lMaxH As Double  ' Maximale Höhe in 1/100 mm

  'lMaxW = 6.75 * 2540 ' 6,75 Zoll
  'lMaxH = 9.5 * 2540  ' 9,5 Zoll
  lMaxW = 17000 ' 17 cm
  lMaxH = 24000 ' 24 cm
  
  If IsNull(oGraph) OR IsEmpty(oGraph) Then
    Exit Function
  End If
  oSize = oGraph.Size100thMM
  If oSize.Height = 0 OR oSize.Width = 0 Then
    ' 2540 ist ein Zoll, umgerechnet in 1/100 mm.
    ' Ein Zoll hat 14440 Twips.
    oSize.Height = oGraph.SizePixel.Height * 2540.0 * TwipsPerPixelY() / 1440
    oSize.Width = oGraph.SizePixel.Width * 2540.0 * TwipsPerPixelX() / 1440
  End If
  If oSize.Height = 0 OR oSize.Width = 0 Then
    'oSize.Height = 2540
    'oSize.Width = 2540
    Exit Function
  End If
  If oSize.Width > lMaxW Then
    oSize.Height = oSize.Height * lMaxW / oSize.Width
    oSize.Width = lMaxW
  End If
  If oSize.Height > lMaxH Then
    oSize.Width = oSize.Width * lMaxH / oSize.Height
    oSize.Height = lMaxH
  End If
  RecommendGraphSize = oSize
End Function

Gruß Frieder

[DAP]

Hallo Frieder,

das war genau das, was ich gesucht habe. Vielen Dank für Deine Bemühungen.

Gruß DAP