summaryrefslogtreecommitdiff
path: root/wizards/source/euro/Hard.xba
blob: c500946bd9d59e8cdfb03ec079a8169b9e1d15f9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Hard" script:language="StarBasic">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 &lt;&gt; 1) Then
		&apos; Conversion on a sheet?
		SetStatusLineText(sStsRELRANGES)
		osheet = oDocument.CurrentController.GetActiveSheet
		oRanges = osheet.CellFormatRanges.createEnumeration()
		MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, False)
		If MaxIndex &gt; -1 Then
			ReDim Preserve RangeList(MaxIndex)
		End If
	Else
		CreateRangeEnumeration(False)
		bRangeListDefined = True
	End If
	EnableStep1DialogControls(True, True, True)
	SetStatusLineText(&quot;&quot;)
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
		&apos; 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),&quot;%1Number%1&quot;)
				sStatustext = ReplaceString(sStatusText,oSheets.Count,&quot;%2TotPageCount%2&quot;)
				SetStatusLineText(sStatusText)
			End If
			oRanges = osheet.CellFormatRanges.createEnumeration
			MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, bAutopilot)
		Next i
	Else
		If Not bAutoPilot Then
			SetStatusLineText(sStsRELRANGES)
			&apos; cellranges already defined
			For i = 0 To Ubound(RangeList())
				If RangeList(i) &lt;&gt; &quot;&quot; Then
					AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i))
				End If
			Next
		End If
	End If
	If MaxIndex &gt; -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
			&apos; The Ranges are only passed to an Array when the whole Document is the basis
			&apos; Redimension the RangeList Array if necessary
			MaxIndex = Ubound(RangeList())
			r = r + 1
			If r &gt; MaxIndex Then
				MaxIndex = MaxIndex + SBRANGEUBOUND
				ReDim Preserve RangeList(MaxIndex)
			End If
			RangeList(r) = RangeName
		End If
	Wend
	AddSheetRanges = r
End Function


&apos; 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)
		&apos; Is the Range already included in the collection?
		oRange = RetrieveRangeoutOfRangename(SelItem)
		TotCellCount = TotCellCount + CountRangeCells(oRange)
		DescriptionList() = ArrayOutofString(SelItem,&quot;.&quot;,1)
		SheetRangeName = DeleteStr(DescriptionList(0),&quot;&apos;&quot;)
		If SheetRangeName = CurSheetName Then
			oSelRanges.InsertbyName(&quot;&quot;,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(&quot;lstSelection&quot;)
	Lastindex = Ubound(ListboxList())
	If TotCellCount &gt; 0 Then
		OldStatusValue = StatusValue
		&apos; 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(&quot;NumberFormat&quot;) &lt;&gt; 1 Then
					&apos; 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 &gt; 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
	&apos; 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)= &quot;&quot; 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</script:module>