xref: /aoo42x/main/wizards/source/euro/Hard.xba (revision b53bcc32)
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 &lt;&gt; 1) Then
36		&apos; 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 &gt; -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(&quot;&quot;)
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		&apos; 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),&quot;%1Number%1&quot;)
67				sStatustext = ReplaceString(sStatusText,oSheets.Count,&quot;%2TotPageCount%2&quot;)
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			&apos; cellranges already defined
77			For i = 0 To Ubound(RangeList())
78				If RangeList(i) &lt;&gt; &quot;&quot; Then
79					AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i))
80				End If
81			Next
82		End If
83	End If
84	If MaxIndex &gt; -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			&apos; The Ranges are only passed to an Array when the whole Document is the basis
109			&apos; Redimension the RangeList Array if necessary
110			MaxIndex = Ubound(RangeList())
111			r = r + 1
112			If r &gt; 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&apos; 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		&apos; Is the Range already included in the collection?
139		oRange = RetrieveRangeoutOfRangename(SelItem)
140		TotCellCount = TotCellCount + CountRangeCells(oRange)
141		DescriptionList() = ArrayOutofString(SelItem,&quot;.&quot;,1)
142		SheetRangeName = DeleteStr(DescriptionList(0),&quot;&apos;&quot;)
143		If SheetRangeName = CurSheetName Then
144			oSelRanges.InsertbyName(&quot;&quot;,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(&quot;lstSelection&quot;)
160	Lastindex = Ubound(ListboxList())
161	If TotCellCount &gt; 0 Then
162		OldStatusValue = StatusValue
163		&apos; 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(&quot;NumberFormat&quot;) &lt;&gt; 1 Then
176					&apos; 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 &gt; 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	&apos; 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)= &quot;&quot; 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