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