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

[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

[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

[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

[DPunch]

Aloha

Du musst natürlich den Pfad enstsprechend anpassen

Code: Alles auswählen

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

[sik]

Danke,
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

[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

[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
SIK
(Steffen )

[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.

Steffen

[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

[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.


Danke Steffen

[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)

[sik]

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

[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?

[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

[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ß

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