will in Calc mit einem Makro ein Bild einfügen. - Aber richtig einfügen - damit eine Kopie auch im "Container" gespeichert wird.
Achtung ! Keinen Link erstellen.
Das erste Makro (hab ich irgendwo runtergeladen) habe ich umschreiben können. Aber es erstellt nur einen Link.
(d.h. wenn die Originaldatei gelöscht ist, ist das Bild in Calc auch weg.)
Code: Alles auswählen
REM ***** BASIC *****
Sub BildEinfuegen
Dim oDoc as Object
Dim mySheet as Object
Dim oCell as Object
Dim Page as Object
Dim GrafikName as String
oDoc = thisComponent
mySheet = oDoc.Sheets(0)
Page = mySheet.drawPage
NewGrafik = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
oCell = mySheet.getCellRangeByName("A1")
GrafikName = ConvertToURL(oCell.String)
NewGrafik.GraphicURL=GrafikName
NewGrafik.name = GrafikName
oCell = mysheet.getcellRangebyName("C5")'Ankerposition festlegen
page.add(NewGrafik)
NewGrafik.Anchor = oCell
Dim Size As New com.sun.star.awt.Size
oBildGroesse =NewGrafik.GraphicObjectFillBitmap.GetSize
hoehe = oBildGroesse.height ' in Pixeln
breite = oBildGroesse.width 'in Pixeln
dim oGrafikGroesse as new com.sun.star.awt.Size
oGrafikGroesse.height = hoehe * 20 'Grösse festlegen
oGrafikGroesse.width = breite * 20
NewGrafik.setSize(oGrafikGroesse)
End Sub
Code: Alles auswählen
REM ***** BASIC *****
Sub Bild2einfuegen
sImgPath = "C:\DSC02329.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
End sub
Das 3 Makro habe ich nicht zum Laufen gebracht.
Ich wollte das 2 Makro mit dem ersten ergänzen, um es so zum laufen zu bringen.
Ich verstehe auch diesem Cod nicht richtig.
Es kommt ein Fehler in der Zeile wo "myPic" steht. Aber ich kann mit "myPic" nichts anfagen.
Code: Alles auswählen
Sub Test
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:\C:\DSC02329.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
Wie ist der Befehl ein Bild per Makro einzufügen (und nicht verlinken) ?
Es funktioniert bei mir nur mit "drag and drop" das kann ich mit dem Makrorekorder nicht aufzeichnen.
Über Menü Einfügen .... funktioniert es auch nicht.
Danke.
LG
Bernhard