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