1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Soft" script:language="StarBasic">Option Explicit 4REM ***** BASIC ***** 5 6 7Sub CreateStyleEnumeration() 8 EmptySelection() 9 EmptyListbox(DialogModel.lstSelection) 10 CurSheetName = oDocument.CurrentController.GetActiveSheet.Name 11 MakeStyleEnumeration(False) 12 DialogModel.lblSelection.Label = sTEMPLATES 13End Sub 14 15 16Sub MakeStyleEnumeration(bAddToListbox as Boolean) 17Dim m as integer 18Dim aStyleFormat as Object 19Dim Stylename as String 20 StyleIndex = -1 21 oStyles = oDocument.StyleFamilies.GetbyIndex(0) 22 For m = 0 To oStyles.count-1 23 oStyle = oStyles.GetbyIndex(m) 24 StyleName = oStyle.Name 25 If CheckFormatType(oStyle) Then 26 If Not bAddToListBox Then 27 AddSingleItemToListbox(DialogModel.lstSelection, Stylename) 28 Else 29 SwitchNumberFormat(ostyle, oFormats, sEuroSign) 30 End If 31 StyleIndex = StyleIndex + 1 32 If StyleIndex > Ubound(StyleRangeAssignMentList()) Then 33 Redim Preserve StyleRangeAssignmentList(StyleIndex) 34 End If 35 StyleRangeAssignmentList(StyleIndex) = "<STYLENAME>" & Stylename & "</STYLENAME>" & _ 36 "<DEFINED>FALSE</DEFINED>" & "<RANGES></RANGES>" &_ 37 "<CELLCOUNT>0</CELLCOUNT>" &_ 38 "<SELECTED>FALSE</SELECTED>" 39 End If 40 Next m 41 If StyleIndex > -1 Then 42 Redim Preserve StyleRangeAssignmentList(StyleIndex) 43 Else 44 ReDim StyleRangeAssignmentList() 45 End If 46End Sub 47 48 49Sub AssignRangestoStyle(StyleList(), SelList()) 50Dim i as Integer 51Dim n as integer 52Dim LastIndex as Integer 53Dim CurStyleName as String 54Dim AssignString as String 55 LastIndex = Ubound(StyleList()) 56 StatusValue = 0 57 SetStatusLineText(sStsRELRANGES) 58 For i = 0 To LastIndex 59 CurStyleName = StyleList(i) 60 n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0) 61 AssignString = StyleRangeAssignmentlist(n) 62 If IndexInArray(CurStyleName, SelList()) <> -1 Then 63 ' Style is selected 64 If FindPartString(AssignString, "<DEFINED>", "</DEFINED>", 1) = "FALSE" Then 65 AssignString = ReplaceString(AssignString, "<SELECTED>TRUE</SELECTED>", "<SELECTED>FALSE</SELECTED>") 66 AssignCellFormatRanges(n, AssignString, CurStyleName) 67 End If 68 Else 69 ' Style is not selected 70 If FindPartString(AssignString, "<SELECTED>", "</SELECTED>", 1) = "FALSE" Then 71 DeselectStyle(CurStyleName, n) 72 End If 73 End If 74 IncreaseStatusvalue(SBRELGET/(LastIndex+1)) 75 Next i 76End Sub 77 78 79Sub AssignCellFormatRanges(n as Integer, AssignString as String, CurStyleName as String) 80Dim oRanges() as Object 81Dim oRange as Object 82Dim oRangeAddress 83Dim oSheet as Object 84Dim StyleCellCount as Long 85Dim i as Integer 86Dim MaxIndex as Integer 87Dim RangeString as String 88Dim SheetName as String 89Dim RangeName as String 90Dim CellCountString as String 91 StyleCellCount = 0 92 RangeString = "<RANGES>" 93 MaxIndex = oSheets.Count-1 94 For i = 0 To MaxIndex 95 oSheet = oSheets(i) 96 SheetName = oSheet.Name 97 oRanges = osheet.CellFormatRanges.CreateEnumeration 98 While oRanges.hasMoreElements 99 oRange = oRanges.NextElement 100 If oRange.getPropertyState("NumberFormat") = 1 Then 101 If oRange.CellStyle = CurStyleName Then 102 oRangeAddress = oRange.RangeAddress 103 RangeName = RetrieveRangeNamefromAddress(oRange) 104 RangeString = RangeString & RangeName & "," 105 StyleCellCount = StyleCellCount + CountRangeCells(oRange) 106 End If 107 End If 108 Wend 109 Next i 110 If StyleCellCount > 0 Then 111 TotCellCount = TotCellCount + StyleCellCount 112 RangeString = RTrimStr(RangeString,",") 113 RangeString = RangeString & "</RANGES>" 114 CellCountString = "<CELLCOUNT>" & StyleCellCount & "</CELLCOUNT" 115 AssignString = ReplaceString(AssignString, RangeString,"<RANGES></RANGES>") 116 AssignString = ReplaceString(AssignString, CellCountString,"<CELLCOUNT>0</CELLCOUNT>") 117 End If 118 AssignString = ReplaceString(AssignString, "<DEFINED>TRUE</DEFINED>", "<DEFINED>FALSE</DEFINED>") 119 StyleRangeAssignmentList(n) = AssignString 120End Sub 121 122 123' deletes a styletemplate from the Collection that selects the ranges 124Sub DeselectStyle(DeSelStyleName as String, n as Integer) 125Dim i as Integer 126Dim RangeName as String 127Dim SelectString as String 128Dim AssignString as String 129Dim StyleRangeList() as String 130Dim MaxIndex as Integer 131 SelectString ="<SELECTED>FALSE</SELECTED>" 132 AssignString = StyleRangeAssignmentList(n) 133 RangeString = FindPartString(AssignString,"<RANGES>","</RANGES>",1) 134 StyleRangeList() = ArrayoutofString(RangeString,",") 135 MaxIndex = Ubound(StyleRangeList()) 136 For i = 0 To MaxIndex 137 RangeName = StyleRangeList(i) 138 If oSelRanges.HasbyName(RangeName) Then 139 oSelRanges.RemovebyName(RangeName) 140 End If 141 Next i 142 AssignString = ReplaceString(AssignString, "<SELECTED>FALSE</SELECTED>", "<SELECTED>TRUE</SELECTED>") 143 StyleRangeAssignmentList(n) = AssignString 144End Sub 145 146 147Function RetrieveRangeNamefromAddress(oRange as Object) as String 148Dim Rangename as String 149Dim oAddressRanges as Object 150 oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") 151 oAddressRanges.InsertbyName("",oRange) 152 Rangename = oAddressRanges.RangeAddressesasString 153' Msgbox "Adresse: " & oRangeAddress.StartColumn & " ; " & oRangeAddress.EndColumn & " ; " & oRangeAddress.StartRow & " ; " & oRangeAddress.EndRow & chr(13) & RangeName 154' oAddressRanges.RemovebyName(RangeName) 155 RetrieveRangeNamefromAddress = Rangename 156End Function 157 158 159' creates a sheet object from an according sectionname 160Function RetrieveSheetoutofRangeName(TableText as String) 161Dim DescriptionList() as String 162Dim SheetName as String 163Dim MaxIndex as integer 164 ' find out in which sheet the range is 165 DescriptionList() = ArrayOutofString(TableText,".",MaxIndex) 166 SheetName = DescriptionList(0) 167 SheetName = DeleteStr(SheetName,"'") 168 ' set the viewcursor on this sheet 169 RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName) 170End Function 171 172 173' creates a rangeobject from an according rangename 174Function RetrieveRangeoutofRangeName(TableText as String) 175 oSheet = RetrieveSheetoutofRangeName(TableText) 176 oRange = oSheet.GetCellRangebyName(TableText) 177 RetrieveRangeoutofRangeName = oRange 178End Function 179 180 181Sub ConvertTheSoftWay(StyleList(), bDeSelect as Boolean) 182Dim i as Integer 183Dim l as Integer 184Dim s as Integer 185Dim n as Integer 186Dim CurStyleName as String 187Dim RangeName as String 188Dim OldStatusValue as Integer 189Dim LastIndex as Integer 190Dim oSelListbox as Object 191Dim StyleRangeList() as String 192Dim MaxIndex as Integer 193 oSelListbox = DialogConvert.GetControl("lstSelection") 194 LastIndex = Ubound(StyleList()) 195 OldStatusValue = StatusValue 196 For i = 0 To LastIndex 197 CurStyleName = StyleList(i) 198 oStyle = oStyles.GetbyName(CurStyleName) 199 StyleRangeList() = GetAssignedRanges(CurStyleName, n) 200 MaxIndex = Ubound(StyleRangeList()) 201 For s = 0 To MaxIndex 202 RangeName = StyleRangeList(s) 203 oRange = RetrieveRangeoutofRangeName(RangeName) 204 If oRange.getPropertyState("NumberFormat") = 1 Then 205 ' Range is hard formatted 206 ConvertCellCurrencies(oRange) 207 CurCellCount = CountRangeCells(oRange) 208 End If 209 IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue)) 210 If bDeSelect Then 211 ' Note: On Problems see Bug #73157 212 If oSelRanges.HasbyName(RangeName) Then 213 oSelRanges.RemovebyName(RangeName) 214 oDocument.CurrentController.Select(oSelRanges) 215 End If 216 End If 217 Next s 218 SwitchNumberFormat(ostyle, oFormats, sEuroSign) 219 StyleRangeAssignmentList(n) = "" 220 l = GetItemPos(oSelListBox.Model, CurStyleName) 221 oSelListbox.RemoveItems(l,1) 222 Next 223End Sub 224 225 226Function GetAssignedRanges(CurStyleName as String, n as Integer) 227Dim StyleRangeList() as String 228Dim RangeString as String 229Dim AssignString as String 230 n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0) 231 If n <> -1 Then 232 AssignString = StyleRangeAssignmentList(n) 233 RangeString = FindPartString(AssignString,"<RANGES>", "</RANGES>",1) 234 If RangeString <> "" Then 235 StyleRangeList() = ArrayoutofString(RangeString,",") 236 End If 237 End If 238 GetAssignedRanges() = StyleRangeList() 239End Function</script:module>