REM ***** BASIC ***** Option Explicit Sub CreateRangeList() Dim MaxIndex as Integer MaxIndex = -1 EnableStep1DialogControls(False, False, False) EmptySelection() DialogModel.lblSelection.Label = sCURRRANGES EmptyListbox(DialogModel.lstSelection) oDocument.CurrentController.Select(oSelRanges) If (DialogModel.optSheetRanges.State = 1) AND (DialogModel.chkComplete.State <> 1) Then ' Conversion on a sheet? SetStatusLineText(sStsRELRANGES) osheet = oDocument.CurrentController.GetActiveSheet oRanges = osheet.CellFormatRanges.createEnumeration() MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, False) If MaxIndex > -1 Then ReDim Preserve RangeList(MaxIndex) End If Else CreateRangeEnumeration(False) bRangeListDefined = True End If EnableStep1DialogControls(True, True, True) SetStatusLineText("") End Sub Sub CreateRangeEnumeration(bAutopilot as Boolean) Dim i as Integer Dim MaxIndex as integer Dim sStatustext as String MaxIndex = -1 If Not bRangeListDefined Then ' Cellranges are not yet defined oSheets = oDocument.Sheets For i = 0 To oSheets.Count-1 oSheet = oSheets.GetbyIndex(i) If bAutopilot Then IncreaseStatusValue(SBRELGET/osheets.Count) Else sStatustext = ReplaceString(sStsRELSHEETRANGES,Str(i+1),"%1Number%1") sStatustext = ReplaceString(sStatusText,oSheets.Count,"%2TotPageCount%2") SetStatusLineText(sStatusText) End If oRanges = osheet.CellFormatRanges.createEnumeration MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, bAutopilot) Next i Else If Not bAutoPilot Then SetStatusLineText(sStsRELRANGES) ' cellranges already defined For i = 0 To Ubound(RangeList()) If RangeList(i) <> "" Then AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i)) End If Next End If End If If MaxIndex > -1 Then ReDim Preserve RangeList(MaxIndex) Else ReDim RangeList() End If Rangeindex = MaxIndex End Sub Function AddSheetRanges(oRanges as Object, r as Integer, oSheet as Object, bAutopilot) Dim RangeName as String Dim AddtoList as Boolean Dim iCurStep as Integer Dim MaxIndex as Integer iCurStep = DialogModel.Step While oRanges.hasMoreElements oRange = oRanges.NextElement AddToList = CheckFormatType(oRange) If AddToList Then RangeName = RetrieveRangeNamefromAddress(oRange) TotCellCount = TotCellCount + CountRangeCells(oRange) If Not bAutoPilot Then AddSingleItemToListbox(DialogModel.lstSelection, RangeName) End If ' The Ranges are only passed to an Array when the whole Document is the basis ' Redimension the RangeList Array if necessary MaxIndex = Ubound(RangeList()) r = r + 1 If r > MaxIndex Then MaxIndex = MaxIndex + SBRANGEUBOUND ReDim Preserve RangeList(MaxIndex) End If RangeList(r) = RangeName End If Wend AddSheetRanges = r End Function ' adds a section to the collection Sub SelectRange() Dim i as Integer Dim RangeName as String Dim SelItem as String Dim CurRange as String Dim SheetRangeName as String Dim DescriptionList() as String Dim MaxRangeIndex as Integer Dim StatusValue as Integer StatusValue = 0 MaxRangeIndex = Ubound(SelRangeList()) CurSheetName = oSheet.Name For i = 0 To MaxRangeIndex SelItem = SelRangeList(i) ' Is the Range already included in the collection? oRange = RetrieveRangeoutOfRangename(SelItem) TotCellCount = TotCellCount + CountRangeCells(oRange) DescriptionList() = ArrayOutofString(SelItem,".",1) SheetRangeName = DeleteStr(DescriptionList(0),"'") If SheetRangeName = CurSheetName Then oSelRanges.InsertbyName("",oRange) End If IncreaseStatusValue(SBRELGET/MaxRangeIndex) Next i End Sub Sub ConvertThehardWay(ListboxList(), SwitchFormat as Boolean, bRemove as Boolean) Dim i as Integer Dim AddCells as Long Dim OldStatusValue as Single Dim RangeName as String Dim LastIndex as Integer Dim oSelListbox as Object oSelListbox = DialogConvert.GetControl("lstSelection") Lastindex = Ubound(ListboxList()) If TotCellCount > 0 Then OldStatusValue = StatusValue ' hard format For i = 0 To LastIndex RangeName = ListboxList(i) oRange = RetrieveRangeoutofRangeName(RangeName) ConvertCellCurrencies(oRange) If bRemove Then If oSelRanges.HasbyName(RangeName) Then oSelRanges.RemovebyName(RangeName) oDocument.CurrentController.Select(oSelRanges) End If End If If SwitchFormat Then If oRange.getPropertyState("NumberFormat") <> 1 Then ' Range is hard formatted SwitchNumberFormat(oRange, oFormats, sEuroSign) End If Else SwitchNumberFormat(oRange, oFormats, sEuroSign) End If AddCells = CountRangeCells(oRange) CurCellCount = AddCells IncreaseStatusValue((CurCellCount/TotCellCount)*(100-OldStatusValue)) If bRemove Then RemoveListBoxItemByName(oSelListbox.Model,Rangename) End If Next End If End Sub Sub ConvertCellCurrencies(oRange as Object) Dim oValues as Object Dim oCells as Object Dim oCell as Object oValues = oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE) If (oValues.Count > 0) Then oCells = oValues.Cells.createEnumeration While oCells.hasMoreElements oCell = oCells.nextElement ModifyObjectValuewithCurrFactor(oCell) Wend End If End Sub Sub ModifyObjectValuewithCurrFactor(oDocObject as Object) Dim oDocObjectValue as double oDocObjectValue = oDocObject.Value oDocObject.Value = Round(oDocObjectValue/CurrFactor, 2) End Sub Function CheckIfRangeisCurrency(FormatObject as Object) Dim oFormatofObject() as Object ' Retrieve the Format of the Object On Local Error GoTo NOKEY oFormatofObject() = oFormats.getByKey(FormatObject.NumberFormat) On Local Error GoTo 0 CheckIfRangeIsCurrency = INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY Exit Function NOKEY: CheckIfRangeisCurrency = False Resume CLERROR CLERROR: End Function Function CountColumnsForRow(IndexArray() as String, Row as Integer) Dim i as Integer Dim NoNulls as Boolean For i = 1 To Ubound(IndexArray,2) If IndexArray(Row,i)= "" Then NoNulls = False Exit For End If Next CountColumnsForRow = i End Function Function CountRangeCells(oRange as Object) As Long Dim oRangeAddress as Object Dim LocCellCount as Long oRangeAddress = oRange.RangeAddress LocCellCount = (oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1) * (oRangeAddress.EndRow - oRangeAddress.StartRow + 1) CountRangeCells = LocCellCount End Function