Textfeld in Calc einfügen

[F3K Total]

Hallo,
ich habe da mal was gebastelt:

Code: Alles auswählen

sub insert_Textfield_with_image

Dim Point As New com.sun.star.awt.Point
Dim new_Original_Size As New com.sun.star.awt.Size
Dim Size As New com.sun.star.awt.Size
Dim Size_max As New com.sun.star.awt.Size

odoc = ThisComponent
osheet = odoc.sheets.getbyname("Tabelle1")
opage = osheet.drawpage
s_urlBitmap = "file:///C:/Users/.../MyBitmap.png" 'Url zur Bitmap
'mit s_urlBitmap =  converttourl("C:\Users\...\MyBitmap.png") geht es auch

oshape= odoc.createInstance("com.sun.star.drawing.GraphicObjectShape")

Point.x = 6000
Point.y = 6000
Size.Width = 5000
Size.Height = 3000

with oshape
  .Size = Size
  .Position = Point
  .LineStyle=0
  .GraphicURL=s_urlBitmap 'verknüpft
  .name="my_Grafik"
end with 

opage.add(oshape) 

with oshape
  .String="Dies ist mein Text, und der gefällt mir sehr gut!"
  .CharFontName="Arial"
  .CharHeight=12
  .TextHorizontalAdjust=2
  .TextVerticalAdjust=0
  .ParaAdjust=1
  .TextContourFrame = TRUE
end with

oBitmap = odoc.createInstance( "com.sun.star.drawing.BitmapTable" )
sName$ = oshape.Name

If oBitMap.hasByName(sName) Then
oBitmap.replaceByName( sName, oshape.GraphicURL )
else
oBitmap.insertByName( sName, oshape.GraphicURL )
End If

sNewURL$ = oBitmap.getByName( sName )
oshape.GraphicURL = sNewURL 'Embeddet

Original_Size=oshape.Graphic.SizePixel 'Originalgrösse des neuen Bildes auslesen

Size_max.Width=5000
Size_max.Height=3000

Factor_Width=Size_max.width/Original_Size.width
Factor_Height=Size_max.Height/Original_Size.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_Size.width*factor
size.Height=Original_Size.Height*factor

oshape.size=size

end sub

Viel Erfolg damit
Gruß R