Option Explicit REM ***** BASIC ***** Sub CreateStyleEnumeration() EmptySelection() EmptyListbox(DialogModel.lstSelection) CurSheetName = oDocument.CurrentController.GetActiveSheet.Name MakeStyleEnumeration(False) DialogModel.lblSelection.Label = sTEMPLATES End Sub Sub MakeStyleEnumeration(bAddToListbox as Boolean) Dim m as integer Dim aStyleFormat as Object Dim Stylename as String StyleIndex = -1 oStyles = oDocument.StyleFamilies.GetbyIndex(0) For m = 0 To oStyles.count-1 oStyle = oStyles.GetbyIndex(m) StyleName = oStyle.Name If CheckFormatType(oStyle) Then If Not bAddToListBox Then AddSingleItemToListbox(DialogModel.lstSelection, Stylename) Else SwitchNumberFormat(ostyle, oFormats, sEuroSign) End If StyleIndex = StyleIndex + 1 If StyleIndex > Ubound(StyleRangeAssignMentList()) Then Redim Preserve StyleRangeAssignmentList(StyleIndex) End If StyleRangeAssignmentList(StyleIndex) = "<STYLENAME>" & Stylename & "</STYLENAME>" & _ "<DEFINED>FALSE</DEFINED>" & "<RANGES></RANGES>" &_ "<CELLCOUNT>0</CELLCOUNT>" &_ "<SELECTED>FALSE</SELECTED>" End If Next m If StyleIndex > -1 Then Redim Preserve StyleRangeAssignmentList(StyleIndex) Else ReDim StyleRangeAssignmentList() End If End Sub Sub AssignRangestoStyle(StyleList(), SelList()) Dim i as Integer Dim n as integer Dim LastIndex as Integer Dim CurStyleName as String Dim AssignString as String LastIndex = Ubound(StyleList()) StatusValue = 0 SetStatusLineText(sStsRELRANGES) For i = 0 To LastIndex CurStyleName = StyleList(i) n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0) AssignString = StyleRangeAssignmentlist(n) If IndexInArray(CurStyleName, SelList()) <> -1 Then ' Style is selected If FindPartString(AssignString, "<DEFINED>", "</DEFINED>", 1) = "FALSE" Then AssignString = ReplaceString(AssignString, "<SELECTED>TRUE</SELECTED>", "<SELECTED>FALSE</SELECTED>") AssignCellFormatRanges(n, AssignString, CurStyleName) End If Else ' Style is not selected If FindPartString(AssignString, "<SELECTED>", "</SELECTED>", 1) = "FALSE" Then DeselectStyle(CurStyleName, n) End If End If IncreaseStatusvalue(SBRELGET/(LastIndex+1)) Next i End Sub Sub AssignCellFormatRanges(n as Integer, AssignString as String, CurStyleName as String) Dim oRanges() as Object Dim oRange as Object Dim oRangeAddress Dim oSheet as Object Dim StyleCellCount as Long Dim i as Integer Dim MaxIndex as Integer Dim RangeString as String Dim SheetName as String Dim RangeName as String Dim CellCountString as String StyleCellCount = 0 RangeString = "<RANGES>" MaxIndex = oSheets.Count-1 For i = 0 To MaxIndex oSheet = oSheets(i) SheetName = oSheet.Name oRanges = osheet.CellFormatRanges.CreateEnumeration While oRanges.hasMoreElements oRange = oRanges.NextElement If oRange.getPropertyState("NumberFormat") = 1 Then If oRange.CellStyle = CurStyleName Then oRangeAddress = oRange.RangeAddress RangeName = RetrieveRangeNamefromAddress(oRange) RangeString = RangeString & RangeName & "," StyleCellCount = StyleCellCount + CountRangeCells(oRange) End If End If Wend Next i If StyleCellCount > 0 Then TotCellCount = TotCellCount + StyleCellCount RangeString = RTrimStr(RangeString,",") RangeString = RangeString & "</RANGES>" CellCountString = "<CELLCOUNT>" & StyleCellCount & "</CELLCOUNT" AssignString = ReplaceString(AssignString, RangeString,"<RANGES></RANGES>") AssignString = ReplaceString(AssignString, CellCountString,"<CELLCOUNT>0</CELLCOUNT>") End If AssignString = ReplaceString(AssignString, "<DEFINED>TRUE</DEFINED>", "<DEFINED>FALSE</DEFINED>") StyleRangeAssignmentList(n) = AssignString End Sub ' deletes a styletemplate from the Collection that selects the ranges Sub DeselectStyle(DeSelStyleName as String, n as Integer) Dim i as Integer Dim RangeName as String Dim SelectString as String Dim AssignString as String Dim StyleRangeList() as String Dim MaxIndex as Integer SelectString ="<SELECTED>FALSE</SELECTED>" AssignString = StyleRangeAssignmentList(n) RangeString = FindPartString(AssignString,"<RANGES>","</RANGES>",1) StyleRangeList() = ArrayoutofString(RangeString,",") MaxIndex = Ubound(StyleRangeList()) For i = 0 To MaxIndex RangeName = StyleRangeList(i) If oSelRanges.HasbyName(RangeName) Then oSelRanges.RemovebyName(RangeName) End If Next i AssignString = ReplaceString(AssignString, "<SELECTED>FALSE</SELECTED>", "<SELECTED>TRUE</SELECTED>") StyleRangeAssignmentList(n) = AssignString End Sub Function RetrieveRangeNamefromAddress(oRange as Object) as String Dim Rangename as String Dim oAddressRanges as Object oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") oAddressRanges.InsertbyName("",oRange) Rangename = oAddressRanges.RangeAddressesasString ' Msgbox "Adresse: " & oRangeAddress.StartColumn & " ; " & oRangeAddress.EndColumn & " ; " & oRangeAddress.StartRow & " ; " & oRangeAddress.EndRow & chr(13) & RangeName ' oAddressRanges.RemovebyName(RangeName) RetrieveRangeNamefromAddress = Rangename End Function ' creates a sheet object from an according sectionname Function RetrieveSheetoutofRangeName(TableText as String) Dim DescriptionList() as String Dim SheetName as String Dim MaxIndex as integer ' find out in which sheet the range is DescriptionList() = ArrayOutofString(TableText,".",MaxIndex) SheetName = DescriptionList(0) SheetName = DeleteStr(SheetName,"'") ' set the viewcursor on this sheet RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName) End Function ' creates a rangeobject from an according rangename Function RetrieveRangeoutofRangeName(TableText as String) oSheet = RetrieveSheetoutofRangeName(TableText) oRange = oSheet.GetCellRangebyName(TableText) RetrieveRangeoutofRangeName = oRange End Function Sub ConvertTheSoftWay(StyleList(), bDeSelect as Boolean) Dim i as Integer Dim l as Integer Dim s as Integer Dim n as Integer Dim CurStyleName as String Dim RangeName as String Dim OldStatusValue as Integer Dim LastIndex as Integer Dim oSelListbox as Object Dim StyleRangeList() as String Dim MaxIndex as Integer oSelListbox = DialogConvert.GetControl("lstSelection") LastIndex = Ubound(StyleList()) OldStatusValue = StatusValue For i = 0 To LastIndex CurStyleName = StyleList(i) oStyle = oStyles.GetbyName(CurStyleName) StyleRangeList() = GetAssignedRanges(CurStyleName, n) MaxIndex = Ubound(StyleRangeList()) For s = 0 To MaxIndex RangeName = StyleRangeList(s) oRange = RetrieveRangeoutofRangeName(RangeName) If oRange.getPropertyState("NumberFormat") = 1 Then ' Range is hard formatted ConvertCellCurrencies(oRange) CurCellCount = CountRangeCells(oRange) End If IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue)) If bDeSelect Then ' Note: On Problems see Bug #73157 If oSelRanges.HasbyName(RangeName) Then oSelRanges.RemovebyName(RangeName) oDocument.CurrentController.Select(oSelRanges) End If End If Next s SwitchNumberFormat(ostyle, oFormats, sEuroSign) StyleRangeAssignmentList(n) = "" l = GetItemPos(oSelListBox.Model, CurStyleName) oSelListbox.RemoveItems(l,1) Next End Sub Function GetAssignedRanges(CurStyleName as String, n as Integer) Dim StyleRangeList() as String Dim RangeString as String Dim AssignString as String n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0) If n <> -1 Then AssignString = StyleRangeAssignmentList(n) RangeString = FindPartString(AssignString,"<RANGES>", "</RANGES>",1) If RangeString <> "" Then StyleRangeList() = ArrayoutofString(RangeString,",") End If End If GetAssignedRanges() = StyleRangeList() End Function