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: libreoffice-bugs@lists.freedesktop.org Reporter: daniel.heise...@gmail.com 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.