Hallo Regina,
ich habe mal folgendes Makro geschrieben.
Es fügt eine Grafik aus der Zwischenablage in ein Writer-Dokument ein.
Die gewünschte Größe wird gesetzt und das Bild/ die Grafik wird
positioniert.
Ab dem Kommentar:
'------------------- Logo zuschneiden
------------------------------------------------------
befindet sich ein auskommentierter Teil, mit dem die Grafik auch
zugeschnitten werden könnte.
Der Code:
REM ***** BASIC *****
'************************************************************************************
' - Dieser Code fügt eine Graifk aus der Zwischenablage in das
Dokument ein.
' - Das Bild ist markiert.
' - Die Größe wird geändert und
' - das Bild wird an seine Zielposition verschoben.
' - Zuschneiden ist mit dem Codeteil Zeile 59 -70 möglich,
' ist aber derzeit auskommentiert.
'*************************************************************************************
Sub InsertLogo
Dim oDoc as object
Dim oShape as Object
Dim oPage as Object
Dim oGraphicCrop as Object
Dim oSel as Object
Dim oFrame as Object
Dim Dispatcher as object
Dim nIndexDraw as Integer
Dim i as Integer
oDoc=ThisComponent
REM ----------------------------------------------------------------------
REM Grafik aus Zwischenablage einfügen
rem get access to the document
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(oFrame, ".uno:Paste", "", 0, Array())
' aktuelle Markierung/ Selektion erfassen
oSel = oDoc.CurrentSelection
' Prüfen ob sich der Inhalt der Selektion ein Grafikobjet ist
' Wenn kein Bild, dann Programm beenden
If oSel.ImplementationName <> "SwXTextGraphicObject" Then
Exit Sub
End If
' xray oSel
' Dem aktuellen Bild einen vorläufigen Namen zuweisen,
' zweck späterer Identifikation
oSel.setName("Bildname")
oPage = oDoc.drawPage
' xray oPage
' Objektzuweisung für das gewünschtes Bild
for i = 0 to oPage.count
oShape = oPage.getByindex(i)
if oshape.name = "Bildname" then
nIndexDraw=i
exit for
End if
next i
'xray oShape(nIndexDraw)
'------------------- Logo zuschneiden
------------------------------------------------------
'oGraphicCrop = oShape.GraphicCrop
' Zuschnitte festlegen
' With oGraphicCrop
' .Top = 1000
' .Bottom = 14000
' .Left = 500
' .Right = 2000
' End With
' Logo entsprechend der obigen Parameter zuschneiden
'oShape.GraphicCrop = oGraphicCrop
'--------------------------------------------------------------------------------------------
'------------------- Logo-Größe ändern
------------------------------------------------------
Dim nB as Long
Dim nH as Long
' Variablen für die Logo-Größe
nB=3000 ' Höhe Logo
nH=3000 ' Breite Logo
' Größenobjekt erstellen
Dim aGrafikGroesse As new com.sun.star.awt.Size
' Größenzuweisung
With aGrafikGroesse
.height = nH
.width = nB
End With
'Größe entsprechend der obigen Parameter zuschneiden dem Logo zuweisen
oShape.setSize(aGrafikGroesse)
'--------------------------------------------------------------------------------------------
'------------------- Logo an Zielposition verschieben
---------------------------------------
With oShape
.HoriOrientPosition=5500 ' = cm * 1000
.VertOrientPosition=6000-560 ' = cm * 1000 [560 = 0,56cm =
relative Höhe des Bildes]
End With
'--------------------------------------------------------------------------------------------
'----------------- Dem Logo einen neuen Bildnamen geben
-------------------------------------
' Bildname = Logo & _ & Zufallszahl (Integer aus Datum)
' das heutige Datum erfassen
Dim xD as Date
Dim nZufall as Long
xD=Date
' Zufallszahl berechnen
nZufall = Int((xD * Rnd) -2)
' dem markierten Objekt einen neuen Namen zuweisen.
oShape.Name="Logo_" & nZufall
End Sub
Viele Grüße
Jürgen
Am 11.02.2021 um 19:03 schrieb Regina Henschel:
Hallo,
hat jemand ein Basic Macro Snippet um ein Custom-Shape (z.B. ein
Smiley) in eine Seite einzufügen?
Hintergrund: Für einen Unittest müsste ich per Code ein Custom-Shape
so einfügen, wie man es mit der Maus macht. Ich habe aber keine Idea
wie das gehen kann. Ein Makro könnte mir vielleicht einen
Lösungsansatz geben.
Mit freundlichen Grüßen
Regina
--
Liste abmelden mit E-Mail an: users+unsubscr...@de.libreoffice.org
Probleme?
https://de.libreoffice.org/hilfe-kontakt/mailing-listen/abmeldung-liste/
Tipps zu Listenmails: https://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: https://listarchives.libreoffice.org/de/users/
Datenschutzerklärung: https://www.documentfoundation.org/privacy
