Option Explicit REM ***** BASIC ***** Sub CreateStyleEnumeration() EmptySelection() EmptyListbox(DialogModel.lstSelection) CurSheetName = oDocument.CurrentController.GetActiveSheet.Name MakeStyleEnumeration(False) DialogModel.lblSelection.Label = sTEMPLATES ' "Vorlagen:" 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 oStatusLine.SetText(sStsRELRANGES) '"Erfassung der relevanten Bereiche..." 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 ' löscht eine Stilvorlage aus der Kollektion, die die Ranges selektiert 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 ' Erzeugt eine Sheetobjekt aus einem entsprechenden Bereichsnamen Function RetrieveSheetoutofRangeName(TableText as String) Dim DescriptionList() as String Dim SheetName as String Dim MaxIndex as integer ' Herausfinden, in welchem Sheet sich der Range befindet DescriptionList() = ArrayOutofString(TableText,".",MaxIndex) SheetName = DescriptionList(0) SheetName = DeleteStr(SheetName,"'") ' Und den ViewCursor auf dieses Sheet setzen RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName) End Function ' Erzeugt eine Rangeobjekt aus einem entsprechenden Bereichsnamen 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 Ist hart formatiert 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) ' oStatusline.SetValue(100) 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