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