https://bugs.documentfoundation.org/show_bug.cgi?id=145558
Bug ID: 145558
Summary: reproducable Crash: VBA insert grafik, save, crash
Product: LibreOffice
Version: 7.2.1.2 release
Hardware: All
OS: Windows (All)
Status: UNCONFIRMED
Severity: normal
Priority: medium
Component: Calc
Assignee: [email protected]
Reporter: [email protected]
Description:
I tried to insert grafiks into calc using a macro.
A reproducable crash occurs when I insert a grafik into a sheet which ist "not
active", scale the grafik and then try to save the document.
Crash can be avoided (see the VBA script) when "focus/activesheet" is switched.
Steps to Reproduce:
REM ***** BASIC *****
sub LoadLogo
odoc = Thiscomponent
grafikname="Logo"
path=replace(Thiscomponent.Location,Thiscomponent.Title,"")
urlgrafik=path+"Logo.png"
oSheet = oDoc.Sheets(0)
ocell = oSheet.getcellbyposition(0,0)
call Insertgrafik(oSheet,ocell,urlgrafik,odoc,grafikname)
call SaveAndExport()
end sub
Sub Insertgrafik(oSheet,ocell,urlgrafik,odoc,grafikname)
Dim Size As New com.sun.star.awt.Size
Dim Size_max As New com.sun.star.awt.Size
' WORKAROUND ---------------------------------------------------
' This ins necessary. Else it will crash when we save afterwards.
oView = Thiscomponent.CurrentController
aSheet= Thiscomponent.getCurrentController().getActiveSheet()
oView.setActiveSheet(oSheet)
'---------------------------------------------------------------
oGrafik = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
oGrafik.GraphicURL = urlgrafik
oGrafik.name = grafikname
'Ankerposition festlegen
oPage = oSheet.drawpage
opage.add(oGrafik)
oGrafik.Anchor = oCell
new_Original_Size = oGrafik.Graphic.SizePixel
'Msgbox("widht:"+new_Original_Size.width+"
Height:"+new_Original_Size.Height)
' Height is im mikrometers
Target_Height=3000
factor=Target_Height/new_Original_Size.Height
size.width = new_Original_Size.width*factor
size.Height = new_Original_Size.Height*factor
oGrafik.setSize(size)
' undo WORKAROUND --------------------------------
oView.setActiveSheet(aSheet)
' ------------------------------------------------
End Sub
Sub DeleteAllPics()
Dim oDoc As Object
Dim oDrawPage As Object
Dim oShape As Object
Dim iShape As Integer
Dim iSheet As Integer
oDoc = ThisComponent
'Achtung löscht Knöpfe!!!
For iSheet = 0 To oDoc.getSheets().getCount() - 1
'oDrawPage = oDoc.getSheets().getByIndex(iSheet).getDrawPage()
oDrawPage = oDoc.Sheets(iSheet).getDrawPage()
'do until iShape = oDrawPage.getCount() > 0
oRange = oDoc.Sheets(iSheet).getCellRangeByName("C2:H9999")
oRange.clearContents(4+1)
For iShape = oDrawPage.getCount() - 1 To 0 Step -1
'For iShape = 0 to oDrawPage.getCount() -1
oShape = oDrawPage.getByIndex(iShape)
'msgbox("iShape: "+iShape+" Name: '"+oShape.Name+"'")
'print "Name: "+oShape.Name
'msgbox("Title:"+oShape.Title)
' name ist unschön. Typ "nicht button wäre besser"
oDoc.Sheets(1).getcellbyposition(2,iShape+1).value=iShape
oDoc.Sheets(1).getcellbyposition(3,iShape+1).setString(oShape.Name)
oDoc.Sheets(1).getcellbyposition(4,iShape+1).setString(oDoc.Sheets(iSheet).getName())
if left(oShape.Name,4) = "Logo" then
oDrawPage.remove(oShape)
endif
Next iShape
'Loop
Next iSheet
End Sub
sub SaveAndExport
' funktioniert gut. Kein uno nötig.
ThisComponent.store()
end sub
Actual Results:
See
See
https://crashreport.libreoffice.org/stats/crash_details/713a7969-10df-4c8e-89ab-f3a927677e53
Expected Results:
No Crash ;-)
Reproducible: Always
User Profile Reset: No
Additional Info:
No other information necessary.
--
You are receiving this mail because:
You are the assignee for the bug.
