OpenOffice.info

deutsches Forum rund um Apache OpenOffice und LibreOffice
http://www.oooforum.de/

Über ein Makro ein bildeinfügen und Größe ändern

http://www.oooforum.de/viewtopic.php?t=39548

Seite 1 von 1

Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Di, 22.06.2010 13:36
von sik
Ich möchte ein beliebiges Bild im JPEG Format in eine Textdatei einfügen und per Makro in eine definierte Größe z.B. 5x7cm ändern,
weiß aber nicht wie es geht?

SIK

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Di, 22.06.2010 15:40
von DPunch
Aloha

Mal ein Beispielcode, wie Du ein Bild am Cursor einfügst:

Code: Alles auswählen

sImgPath = "C:\MeineBilder\meinBild.jpg" 'Pfad zum Bild
nWidth = 5000 'Breite
nHeight = 7000 'Höhe
sImgPath = ConvertToUrl(sImgPath)
oDoc = thisComponent
oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
oBitmaps.insertByName( "myPic", sImgPath )
oPic = oBitmaps.getByName( "myPic" )
oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
With oGraph
	.GraphicURL = oPic
	.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
	.Width = nWidth
	.Height = nHeight
End With
oCursor = oDoc.CurrentController.getViewCursor
If NOT isEmpty(oCursor.TextTable) Then
	oCursor.Cell.insertTextContent(oCursor,oGraph,False)
ElseIf NOT isEmpty(oCursor.TextFrame) Then
	oCursor.TextFrame.insertTextContent(oCursor,oGraph,False)
Else
	oDoc.Text.insertTextContent(oCursor,oGraph,False)
End If

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Mi, 23.06.2010 00:26
von sik
Danke für das Beispiel!, aber es tut sich nichts. Habe das Makro übernommen und es kommt folgende Fehlermeldung:
Basic-Laufzeitfehler.
Es ist eine Execption aufgetreten
Type: com.sun.star.container.NoSuchElementException
Message:.

und die Zeile
oPic=oBitmaps.getByName("myPic") ist markiert

was mache ich falsch?

PS: Für mich ist das auch alles Neuland, liegt also bestimmt an mir, weiß nur nicht was!

SIK

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Mi, 23.06.2010 15:21
von DPunch
Aloha

Du musst natürlich den Pfad enstsprechend anpassen

Code: Alles auswählen

sImgPath = "C:\MeineBilder\meinBild.jpg" 'Pfad zum Bild

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Mi, 23.06.2010 16:27
von sik
Danke, :D
für die schnelle Antwort werde es heute noch ausprobieren!
Kann man den Bilderpfand und auch den Bildnamen flexibel gestalten,
damit man das Makro für jedes beliebige Dokument und jede beliebiges Bild?
Was ich meine ist Bild aussuchen, dann einfügen und dann Grösse ändern, aber immer wieder die gleiche Grösse,
deshalb das Makro.

SIK :shock:

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Mi, 23.06.2010 16:56
von DPunch
Aloha

Auch das geht natürlich

Code: Alles auswählen

nWidth = 5000 'Breite
nHeight = 7000 'Höhe
oFilePickerDlg = createUnoService( "com.sun.star.ui.dialogs.FilePicker" )
oFilePickerDlg.appendFilter("Images","*.jpg;*.jpeg;*.gif;*.bmp;")
oFilePickerDlg.appendFilter("All files","*.*")
oFilePickerDlg.MultiSelectionMode = False
nResult = oFilePickerDlg.execute
If nResult = 0 Then Exit Sub
sImgPath = oFilePickerDlg.Files(0)
oDoc = thisComponent
oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
sInternalPicName = "myPic"
Do While oBitmaps.hasByName(sInternalPicName)
	sInternalPicName = sInternalPicName & "i"
Loop
oBitmaps.insertByName(sInternalPicName, sImgPath )
If NOT oBitmaps.hasByName(sInternalPicName) Then
	MsgBox("Ausgewählte Datei konnte nicht als Grafik eingefügt werden",48,"Fehler")
	Exit Sub
End If
oPic = oBitmaps.getByName(sInternalPicName)
oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
With oGraph
   .GraphicURL = oPic
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_FRAME
   .Width = nWidth
   .Height = nHeight
End With
oCursor = oDoc.CurrentController.getViewCursor
If NOT isEmpty(oCursor.TextTable) Then
   oCursor.Cell.insertTextContent(oCursor,oGraph,False)
ElseIf NOT isEmpty(oCursor.TextFrame) Then
   oCursor.TextFrame.insertTextContent(oCursor,oGraph,False)
Else
   oDoc.Text.insertTextContent(oCursor,oGraph,False)
End If

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Mi, 23.06.2010 17:41
von sik
Hurra,
Danke das Makro ausprobiert und für gut befunden, damit bin ich der Lösung meiner Probleme ein Stück näher!!
Danke :lol:
SIK
(Steffen :D )

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Fr, 09.07.2010 22:47
von sik
Hallo,

ist es Möglich im o.g. Makro, welches gut funktioniert die Automatische Beschriftung mit hinzuzufügen?
Ich habe festgestellt, füge ich ein Bild in Text ein macht er es wie ich eigestellt habe mit Autobeschriftungb benutzte ich das Makro (was ich ja will) funktioniert die die Autobeschriftung nicht. :shock:

Steffen

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Sa, 10.07.2010 17:38
von DPunch
Aloha

So ohne Weiteres ist das nicht meines Wissens nach nicht möglich, aber man kann per Hand improvisieren.

Folgendes Beispiel beschriftet die Bilder automatisch mit "Abbildung" und verwendet die Kategorie "Abbildung" (also als würdest Du die Kategorie "Abbildung" für die Auto-Beschriftung für Bilder wählen).

Code: Alles auswählen

nWidth = 5000 'Breite
nHeight = 7000 'Höhe
sLabel = "Abbildung " 'Beschriftung unter dem Bild

oFilePickerDlg = createUnoService( "com.sun.star.ui.dialogs.FilePicker" )
oFilePickerDlg.appendFilter("Images","*.jpg;*.jpeg;*.gif;*.bmp;")
oFilePickerDlg.appendFilter("All files","*.*")
oFilePickerDlg.MultiSelectionMode = False
nResult = oFilePickerDlg.execute
If nResult = 0 Then Exit Sub
sImgPath = oFilePickerDlg.Files(0)
oDoc = thisComponent
oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
sInternalPicName = "myPic"
For i = 0 To 200
	sInternalPicName = "myPic" & i
	If NOT oBitmaps.hasByName(sInternalPicName) Then Exit For
Next i
oBitmaps.insertByName(sInternalPicName, sImgPath )
If NOT oBitmaps.hasByName(sInternalPicName) Then
   MsgBox("Ausgewählte Datei konnte nicht als Grafik eingefügt werden",48,"Fehler")
   Exit Sub
End If
oDoc.lockControllers
oPic = oBitmaps.getByName(sInternalPicName)
oTextFrame = oDoc.createInstance("com.sun.star.text.TextFrame")
oBorder = oTextFrame.BottomBorder
With oBorder
	.Color = 0
	.InnerLineWidth = 0
	.OuterLineWidth = 0
	.LineDistance = 0
End With
With oTextFrame
	.Width = nWidth
	.Height = nHeight
	.BottomBorder = oBorder
	.TopBorder = oBorder
	.RightBorder = oBorder
	.LeftBorder = oBorder
	.LeftMargin = 0
	.RightMargin = 0
	.TopMargin = 0
	.BottomMargin = 0
	.TextWrap = 0
	.SizeType = 0
	.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
End With

oCursor = oDoc.CurrentController.getViewCursor
On Local Error GoTo ErrorOccured
If NOT isEmpty(oCursor.TextTable) Then
   oCursor.Cell.insertTextContent(oCursor,oTextFrame,False)
ElseIf NOT isEmpty(oCursor.TextFrame) Then
   oCursor.TextFrame.insertTextContent(oCursor,oTextFrame,False)
Else
   oDoc.Text.insertTextContent(oCursor,oTextFrame,False)
End If
oCursor = oTextFrame.createTextCursor

oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
With oGraph
   .GraphicURL = oPic
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
   .Width = nWidth
   .Height = nHeight
End With
oTextFrame.insertTextContent(oCursor,oGraph,False)

oTextFrame.String = sLabel
oTFMaster = oDoc.TextFieldMasters.getByName("com.sun.star.text.fieldmaster.SetExpression.Illustration")
oField = oDoc.createInstance("com.sun.star.text.textfield.SetExpression")
oField.attachTextFieldMaster(oTFMaster)

oCursor.goToEnd(False)
oTextFrame.insertTextContent(oCursor,oField,False)

oCursor.goToStart(True)
oCursor.CharPosture = 2

oDoc.TextFields.refresh
Do While oDoc.hasControllersLocked
	oDoc.unlockControllers
Loop
Exit Sub

ErrorOccured:
MsgBox ("Cursor an ungeeigneter Position (z.B. Grafik)",48,"Fehler")
If oBitmaps.hasByName(sInternalPicName) Then
	oBitmaps.removeByName(sInternalPicName)
End If
Do While oDoc.hasControllersLocked
	oDoc.unlockControllers
Loop

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Di, 13.07.2010 01:02
von sik
Und wiedermal Danke DPunch für die schnelle Antwort.
Habe es gleich ausprobiert und es funktioniert sehr gut.
Frage an welcher Stelle im Code kann man von Buchstaben auf Zahlen umstellen z.B. Abbildung 1.

8)
Danke Steffen

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Di, 13.07.2010 17:09
von DPunch
Aloha

Stell Dir an den Anfang des Codes noch folgende Zuweisung (die neuen Zeilen sind mit dem Pfeil markiert)

Code: Alles auswählen

nWidth = 5000 'Breite
nHeight = 7000 'Höhe
sLabel = "Abbildung " 'Beschriftung unter dem Bild
nNumberingType = com.sun.star.style.NumberingType.ARABIC 'Darstellung des Zählers  <------------------------------------
Die möglicheren Numerierungstypen kannst Du unter api: Numbering Type nachschauen.
Und später im Code fügst Du an der entsprechenden Stelle noch folgende Zeile ein:

Code: Alles auswählen

oTFMaster = oDoc.TextFieldMasters.getByName("com.sun.star.text.fieldmaster.SetExpression.Illustration")
oField = oDoc.createInstance("com.sun.star.text.textfield.SetExpression")
oField.NumberingType = nNumberingType '<--------------------------------------------------------------------
oField.attachTextFieldMaster(oTFMaster)

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Di, 13.07.2010 18:45
von sik
:lol:
Danke für die schnelle Lösung! Habe es auch gleich wieder ausprobiert und es klappt, wie ich es nun schon von dir gewohnt bin.
Grosse Hochachtung!

Danke Steffen
:D

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Mo, 02.04.2012 15:07
von MikeRo
Ich habe noch eine spezielle Frage dazu.

Ich habe teilweise Bilder im Querformat und Hochformat oder anderen Formaten, damit diese nicht verzerren, müsste ich diese in den Originalmaßen einfügen oder Prozentual verkleinert. Wie kann ich das snstellen?

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Mo, 02.04.2012 18:29
von F3K Total
Hallo,
ich habe den Code mal angepasst, ist sicher nicht die eleganteste Lösung, geht aber:

Code: Alles auswählen

Dim Original_SizePixel As New com.sun.star.awt.Size
Dim Size_max As New com.sun.star.awt.Size
Dim Size As New com.sun.star.awt.Size

    Size_max.Width=5000 'maximale Breite
    Size_max.Height=3000 'maximale Höhe


    sImgPath = "C:\MeineBilder\meinBild.jpg" 'Pfad zum Bild
    sImgPath = ConvertToUrl(sImgPath)
    oDoc = thisComponent

    oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
    oBitmaps.insertByName( "myPic", sImgPath )
    oPic = oBitmaps.getByName( "myPic" )
    oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")   
    With oGraph
       .GraphicURL = oPic
       .AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
    End With

    oCursor = oDoc.CurrentController.getViewCursor
    If NOT isEmpty(oCursor.TextTable) Then
       oCursor.Cell.insertTextContent(oCursor,oGraph,False)
    ElseIf NOT isEmpty(oCursor.TextFrame) Then
       oCursor.TextFrame.insertTextContent(oCursor,oGraph,False)
    Else
       oDoc.Text.insertTextContent(oCursor,oGraph,False)
    End If

    Original_SizePixel = oGraph.Graphic.SizePixel
    
    Factor_Width=Size_max.width/Original_SizePixel.width
    Factor_Height=Size_max.Height/Original_SizePixel.Height

    if Factor_Width<=Factor_Height then 'bestimmen ob die Breite oder die Höhe der begrenzende Faktor ist
      factor = Factor_Width
    else
      factor = Factor_Height
    endif

    size.width = Original_SizePixel.width*factor
    size.Height = Original_SizePixel.Height*factor

    oGraph.size=size
    
    end sub
Viel Erfolg,
Gruß R

Re: Über ein Makro ein bildeinfügen und Größe ändern

Verfasst: Do, 23.01.2014 15:28
von trendy2013
Hallo,

bei mir läuft dieses Makro auf einen Fehler "BASIC-Laufzeitfehler - Objektvariable nicht belegt"
.GraphicURL = oPic

Kannst du dir das vielleicht nochmal anschauen.

Benutze OpenOffice Calc 3.2.1

Gruß
DPunch hat geschrieben:Aloha

Auch das geht natürlich

Code: Alles auswählen

nWidth = 5000 'Breite
nHeight = 7000 'Höhe
oFilePickerDlg = createUnoService( "com.sun.star.ui.dialogs.FilePicker" )
oFilePickerDlg.appendFilter("Images","*.jpg;*.jpeg;*.gif;*.bmp;")
oFilePickerDlg.appendFilter("All files","*.*")
oFilePickerDlg.MultiSelectionMode = False
nResult = oFilePickerDlg.execute
If nResult = 0 Then Exit Sub
sImgPath = oFilePickerDlg.Files(0)
oDoc = thisComponent
oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
sInternalPicName = "myPic"
Do While oBitmaps.hasByName(sInternalPicName)
	sInternalPicName = sInternalPicName & "i"
Loop
oBitmaps.insertByName(sInternalPicName, sImgPath )
If NOT oBitmaps.hasByName(sInternalPicName) Then
	MsgBox("Ausgewählte Datei konnte nicht als Grafik eingefügt werden",48,"Fehler")
	Exit Sub
End If
oPic = oBitmaps.getByName(sInternalPicName)
oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
With oGraph
   .GraphicURL = oPic
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_FRAME
   .Width = nWidth
   .Height = nHeight
End With
oCursor = oDoc.CurrentController.getViewCursor
If NOT isEmpty(oCursor.TextTable) Then
   oCursor.Cell.insertTextContent(oCursor,oGraph,False)
ElseIf NOT isEmpty(oCursor.TextFrame) Then
   oCursor.TextFrame.insertTextContent(oCursor,oGraph,False)
Else
   oDoc.Text.insertTextContent(oCursor,oGraph,False)
End If
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de