| <?xml version="1.0" encoding="UTF-8"?> |
| <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> |
| <!--*********************************************************** |
| * |
| * Licensed to the Apache Software Foundation (ASF) under one |
| * or more contributor license agreements. See the NOTICE file |
| * distributed with this work for additional information |
| * regarding copyright ownership. The ASF licenses this file |
| * to you under the Apache License, Version 2.0 (the |
| * "License"); you may not use this file except in compliance |
| * with the License. You may obtain a copy of the License at |
| * |
| * http://www.apache.org/licenses/LICENSE-2.0 |
| * |
| * Unless required by applicable law or agreed to in writing, |
| * software distributed under the License is distributed on an |
| * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| * KIND, either express or implied. See the License for the |
| * specific language governing permissions and limitations |
| * under the License. |
| * |
| ***********************************************************--> |
| <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Soft" script:language="StarBasic">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</script:module> |