Apache OpenOffice Community Forum

Code: Select all

Sub FormulaControl
	Dim aSortFields(1) as New com.sun.star.util.SortField
	Dim aSortDesc(0) as New com.sun.star.beans.PropertyValue

	oDesktop = createUnoService("com.sun.star.frame.Desktop")
	oDocument = ThisComponent										' za potrebe debugginga
	If Not bSkok Then
		sUrl = oDocument.getURL
		If oDocument.IsReadOnly(sUrl) Then
			MsgBox "Document is opened as read-only !!!", 16
			Stop
		End If
	End If
	oSelectedCells = oDocument.CurrentSelection
	If HasUnoInterfaces( oSelectedCells, "com.sun.star.lang.XServiceInfo" ) Then
		If oSelectedCells.supportsService( "com.sun.star.sheet.SheetCellRanges" ) Then
			MsgBox "There is more then one non-contiguous ranges selected. Select one cell only!", 16
			Stop
		End if
		If oSelectedCells.supportsService( "com.sun.star.drawing.Shapes" ) Then
			MsgBox "There is a chart selected. Select one cell only!", 16
			Stop
		End if
	End If
	oActiveCell = oSelectedCells.RangeAddress
	oSheets = oDocument.Sheets
	oSheet = oSheets.getByIndex(oActiveCell.Sheet)						' aktivna tabela
	sName = osheet.Name
	
	bExist = False
	For i = 0 To oSheets.Count - 1
		If oSheets(i).Name = "FormulaControlSheet" Then
			If MsgBox("FormulaControlSheet already exists! Can data be erased?",1) = 1 Then
				bExist = True
				oSheetKont = oSheets(i)
				oCellCursor = oSheetKont.createCursor()
				oCellCursor.gotoEndOfUsedArea( False )
				nLastRow = oCellCursor.getRangeAddress().EndRow
				nLastCol = oCellCursor.getRangeAddress().EndColumn
				oRange = oSheetKont.getCellRangeByPosition(0,0,nLastCol,nLastRow)
				oRange.ClearContents(5)
				Exit For
			Else
				Stop
			End If
		End If
	Next i
	If Not bExist Then
		oSheets.insertNewByName("FormulaControlSheet",0)
		oSheetKont = oSheets.getByName("FormulaControlSheet")
	End If
	oDocument.getCurrentController.select(oSheetKont.getCellByPosition(0,0))
	oSheetKont.getCellByPosition(1,0).String = "Sheet: "& sName
	
	oRange = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
	oRange.insertByName("", oSheet)
	oCells = oRange.Cells.createEnumeration
	i = 1
	While oCells.hasMoreElements
		oCell = oCells.nextElement
		If oCell.Formula <> oCell.String And oCell.Formula <> oCell.Value Then
			row = oCell.CellAddress.Row() + 1
			col = oCell.Columns.ElementNames(0)
			form = oCell.Formula
			tekst = oCell.String
'			If Left(form,6)="='file" Then 'for links only
				oSheetKont.getCellByPosition(0,i).String = col & row
				oSheetKont.getCellByPosition(1,i).String = form
'				oSheetKont.getCellByPosition(2,i).Value = Len(form)
				i = i + 1
'			End If
		End if
	Wend
	For i = 0 To 2
		oColumn = oSheetKont.Columns.getByIndex(i)
		oColumn.OptimalWidth = True
	Next i

	oCellCursor = oSheetKont.createCursor()
	oCellCursor.gotoEndOfUsedArea( False )
	nLastRow = oCellCursor.getRangeAddress().EndRow
	nLastCol = oCellCursor.getRangeAddress().EndColumn
	If nLastRow >= 1 Then
		oRange = oSheetKont.getCellRangeByPosition(0,1,nLastCol,nLastRow)
		aSortFields(0).Field = 1
		aSortFields(0).SortAscending = True
'		aSortFields(0).Field = 3
'		aSortFields(0).SortAscending = False
'		aSortFields(1).Field = 2
'		aSortFields(1).SortAscending = True
		aSortDesc(0).Name = "SortFields"
		aSortDesc(0).Value = aSortFields()
		oRange.Sort(aSortDesc())
		MsgBox "End of formula listing!"
	Else
		MsgBox "There is no formula on sheet " & sName
	End If
End Sub