wizards/source/euro/Soft.xba

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