wizards/source/euro/Hard.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="Hard" script:language="StarBasic">REM  *****  BASIC  *****
  21 Option Explicit
  22
  23
  24 Sub CreateRangeList()
  25 Dim MaxIndex as Integer
  26         MaxIndex = -1
  27         EnableStep1DialogControls(False, False, False)
  28         EmptySelection()
  29         DialogModel.lblSelection.Label = sCURRRANGES
  30         EmptyListbox(DialogModel.lstSelection)
  31         oDocument.CurrentController.Select(oSelRanges)
  32         If (DialogModel.optSheetRanges.State = 1) AND (DialogModel.chkComplete.State &lt;&gt; 1) Then
  33                 &apos; Conversion on a sheet?
  34                 SetStatusLineText(sStsRELRANGES)
  35                 osheet = oDocument.CurrentController.GetActiveSheet
  36                 oRanges = osheet.CellFormatRanges.createEnumeration()
  37                 MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, False)
  38                 If MaxIndex &gt; -1 Then
  39                         ReDim Preserve RangeList(MaxIndex)
  40                 End If
  41         Else
  42                 CreateRangeEnumeration(False)
  43                 bRangeListDefined = True
  44         End If
  45         EnableStep1DialogControls(True, True, True)
  46         SetStatusLineText(&quot;&quot;)
  47 End Sub
  48
  49
  50 Sub CreateRangeEnumeration(bAutopilot as Boolean)
  51 Dim i as Integer
  52 Dim MaxIndex as integer
  53 Dim sStatustext as String
  54         MaxIndex = -1
  55         If Not bRangeListDefined Then
  56                 &apos; Cellranges are not yet defined
  57                 oSheets = oDocument.Sheets
  58                 For i = 0 To oSheets.Count-1
  59                         oSheet = oSheets.GetbyIndex(i)
  60                         If bAutopilot Then
  61                                 IncreaseStatusValue(SBRELGET/osheets.Count)
  62                         Else
  63                                 sStatustext = ReplaceString(sStsRELSHEETRANGES,Str(i+1),&quot;%1Number%1&quot;)
  64                                 sStatustext = ReplaceString(sStatusText,oSheets.Count,&quot;%2TotPageCount%2&quot;)
  65                                 SetStatusLineText(sStatusText)
  66                         End If
  67                         oRanges = osheet.CellFormatRanges.createEnumeration
  68                         MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, bAutopilot)
  69                 Next i
  70         Else
  71                 If Not bAutoPilot Then
  72                         SetStatusLineText(sStsRELRANGES)
  73                         &apos; cellranges already defined
  74                         For i = 0 To Ubound(RangeList())
  75                                 If RangeList(i) &lt;&gt; &quot;&quot; Then
  76                                         AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i))
  77                                 End If
  78                         Next
  79                 End If
  80         End If
  81         If MaxIndex &gt; -1 Then
  82                 ReDim Preserve RangeList(MaxIndex)
  83         Else
  84                 ReDim RangeList()
  85         End If
  86         Rangeindex = MaxIndex
  87 End Sub
  88
  89
  90 Function AddSheetRanges(oRanges as Object, r as Integer, oSheet as Object, bAutopilot)
  91 Dim RangeName as String
  92 Dim AddtoList as Boolean
  93 Dim iCurStep as Integer
  94 Dim MaxIndex as Integer
  95         iCurStep = DialogModel.Step
  96         While oRanges.hasMoreElements
  97                 oRange = oRanges.NextElement
  98                 AddToList = CheckFormatType(oRange)
  99                 If AddToList Then
 100                         RangeName = RetrieveRangeNamefromAddress(oRange)
 101                         TotCellCount = TotCellCount + CountRangeCells(oRange)
 102                         If Not bAutoPilot Then
 103                                 AddSingleItemToListbox(DialogModel.lstSelection, RangeName)
 104                         End If
 105                         &apos; The Ranges are only passed to an Array when the whole Document is the basis
 106                         &apos; Redimension the RangeList Array if necessary
 107                         MaxIndex = Ubound(RangeList())
 108                         r = r + 1
 109                         If r &gt; MaxIndex Then
 110                                 MaxIndex = MaxIndex + SBRANGEUBOUND
 111                                 ReDim Preserve RangeList(MaxIndex)
 112                         End If
 113                         RangeList(r) = RangeName
 114                 End If
 115         Wend
 116         AddSheetRanges = r
 117 End Function
 118
 119
 120 &apos; adds a section to the collection
 121 Sub SelectRange()
 122 Dim i as Integer
 123 Dim RangeName as String
 124 Dim SelItem as String
 125 Dim CurRange as String
 126 Dim SheetRangeName as String
 127 Dim DescriptionList() as String
 128 Dim MaxRangeIndex as Integer
 129 Dim StatusValue as Integer
 130         StatusValue = 0
 131         MaxRangeIndex = Ubound(SelRangeList())
 132         CurSheetName = oSheet.Name
 133         For i = 0 To MaxRangeIndex
 134                 SelItem = SelRangeList(i)
 135                 &apos; Is the Range already included in the collection?
 136                 oRange = RetrieveRangeoutOfRangename(SelItem)
 137                 TotCellCount = TotCellCount + CountRangeCells(oRange)
 138                 DescriptionList() = ArrayOutofString(SelItem,&quot;.&quot;,1)
 139                 SheetRangeName = DeleteStr(DescriptionList(0),&quot;&apos;&quot;)
 140                 If SheetRangeName = CurSheetName Then
 141                         oSelRanges.InsertbyName(&quot;&quot;,oRange)
 142                 End If
 143                 IncreaseStatusValue(SBRELGET/MaxRangeIndex)
 144         Next i
 145 End Sub
 146
 147
 148 Sub ConvertThehardWay(ListboxList(), SwitchFormat as Boolean, bRemove as Boolean)
 149 Dim i as Integer
 150 Dim AddCells as Long
 151 Dim OldStatusValue as Single
 152 Dim RangeName as String
 153 Dim LastIndex as Integer
 154 Dim oSelListbox as Object
 155
 156         oSelListbox = DialogConvert.GetControl(&quot;lstSelection&quot;)
 157         Lastindex = Ubound(ListboxList())
 158         If TotCellCount &gt; 0 Then
 159                 OldStatusValue = StatusValue
 160                 &apos; hard format
 161                 For i = 0 To LastIndex
 162                         RangeName = ListboxList(i)
 163                         oRange = RetrieveRangeoutofRangeName(RangeName)
 164                         ConvertCellCurrencies(oRange)
 165                         If bRemove Then
 166                                 If oSelRanges.HasbyName(RangeName) Then
 167                                         oSelRanges.RemovebyName(RangeName)
 168                                         oDocument.CurrentController.Select(oSelRanges)
 169                                 End If
 170                         End If
 171                         If SwitchFormat Then
 172                                 If oRange.getPropertyState(&quot;NumberFormat&quot;) &lt;&gt; 1 Then
 173                                         &apos; Range is hard formatted
 174                                         SwitchNumberFormat(oRange, oFormats, sEuroSign)
 175                                 End If
 176                         Else
 177                                 SwitchNumberFormat(oRange, oFormats, sEuroSign)
 178                         End If
 179                         AddCells = CountRangeCells(oRange)
 180                         CurCellCount = AddCells
 181                         IncreaseStatusValue((CurCellCount/TotCellCount)*(100-OldStatusValue))
 182                         If bRemove Then
 183                                 RemoveListBoxItemByName(oSelListbox.Model,Rangename)
 184                         End If
 185                 Next
 186         End If
 187 End Sub
 188
 189
 190 Sub ConvertCellCurrencies(oRange as Object)
 191 Dim oValues as Object
 192 Dim oCells as Object
 193 Dim oCell as Object
 194         oValues = oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE)
 195         If (oValues.Count &gt; 0) Then
 196                 oCells = oValues.Cells.createEnumeration
 197                 While oCells.hasMoreElements
 198                         oCell = oCells.nextElement
 199                         ModifyObjectValuewithCurrFactor(oCell)
 200                 Wend
 201         End If
 202 End Sub
 203
 204
 205 Sub ModifyObjectValuewithCurrFactor(oDocObject as Object)
 206 Dim oDocObjectValue as double
 207         oDocObjectValue = oDocObject.Value
 208         oDocObject.Value = Round(oDocObjectValue/CurrFactor, 2)
 209 End Sub
 210
 211
 212 Function CheckIfRangeisCurrency(FormatObject as Object)
 213 Dim oFormatofObject() as Object
 214         &apos; Retrieve the Format of the Object
 215         On Local Error GoTo NOKEY
 216         oFormatofObject() = oFormats.getByKey(FormatObject.NumberFormat)
 217         On Local Error GoTo 0
 218         CheckIfRangeIsCurrency = INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY
 219         Exit Function
 220 NOKEY:
 221         CheckIfRangeisCurrency = False
 222         Resume CLERROR
 223         CLERROR:
 224 End Function
 225
 226
 227 Function CountColumnsForRow(IndexArray() as String, Row as Integer)
 228 Dim i as Integer
 229 Dim NoNulls as Boolean
 230         For i = 1 To Ubound(IndexArray,2)
 231                 If IndexArray(Row,i)= &quot;&quot; Then
 232                         NoNulls = False
 233                         Exit For
 234                 End If
 235         Next
 236         CountColumnsForRow = i
 237 End Function
 238
 239
 240 Function CountRangeCells(oRange as Object) As Long
 241 Dim oRangeAddress as Object
 242 Dim LocCellCount as Long
 243         oRangeAddress = oRange.RangeAddress
 244         LocCellCount = (oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1) * (oRangeAddress.EndRow - oRangeAddress.StartRow + 1)
 245         CountRangeCells = LocCellCount
 246 End Function</script:module>