xref: /aoo42x/main/wizards/source/euro/Soft.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="Soft" script:language="StarBasic">Option Explicit
24REM ***** BASIC *****
25
26
27Sub CreateStyleEnumeration()
28	EmptySelection()
29	EmptyListbox(DialogModel.lstSelection)
30	CurSheetName = oDocument.CurrentController.GetActiveSheet.Name
31	MakeStyleEnumeration(False)
32	DialogModel.lblSelection.Label = sTEMPLATES
33End Sub
34
35
36Sub MakeStyleEnumeration(bAddToListbox as Boolean)
37Dim m as integer
38Dim aStyleFormat as Object
39Dim Stylename as String
40 	StyleIndex = -1
41	oStyles = oDocument.StyleFamilies.GetbyIndex(0)
42	For m = 0 To oStyles.count-1
43		oStyle = oStyles.GetbyIndex(m)
44		StyleName = oStyle.Name
45		If CheckFormatType(oStyle) Then
46			If Not bAddToListBox Then
47				AddSingleItemToListbox(DialogModel.lstSelection, Stylename)
48			Else
49				SwitchNumberFormat(ostyle, oFormats, sEuroSign)
50			End If
51			StyleIndex = StyleIndex + 1
52			If StyleIndex &gt; Ubound(StyleRangeAssignMentList()) Then
53				Redim Preserve StyleRangeAssignmentList(StyleIndex)
54			End If
55			StyleRangeAssignmentList(StyleIndex) = 	&quot;&lt;STYLENAME&gt;&quot; &amp; Stylename &amp; &quot;&lt;/STYLENAME&gt;&quot; &amp; _
56													&quot;&lt;DEFINED&gt;FALSE&lt;/DEFINED&gt;&quot; &amp; &quot;&lt;RANGES&gt;&lt;/RANGES&gt;&quot; &amp;_
57													&quot;&lt;CELLCOUNT&gt;0&lt;/CELLCOUNT&gt;&quot; &amp;_
58													&quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;
59		End If
60	Next m
61	If StyleIndex &gt; -1 Then
62		Redim Preserve StyleRangeAssignmentList(StyleIndex)
63	Else
64		ReDim StyleRangeAssignmentList()
65	End If
66End Sub
67
68
69Sub AssignRangestoStyle(StyleList(), SelList())
70Dim i as Integer
71Dim n as integer
72Dim LastIndex as Integer
73Dim CurStyleName as String
74Dim AssignString as String
75	LastIndex = Ubound(StyleList())
76	StatusValue = 0
77	SetStatusLineText(sStsRELRANGES)
78	For i = 0 To LastIndex
79		CurStyleName = StyleList(i)
80		n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
81		AssignString = StyleRangeAssignmentlist(n)
82		If IndexInArray(CurStyleName, SelList()) &lt;&gt; -1 Then
83			&apos; Style is selected
84			If FindPartString(AssignString, &quot;&lt;DEFINED&gt;&quot;, &quot;&lt;/DEFINED&gt;&quot;, 1) = &quot;FALSE&quot; Then
85				AssignString = ReplaceString(AssignString, &quot;&lt;SELECTED&gt;TRUE&lt;/SELECTED&gt;&quot;, &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;)
86				AssignCellFormatRanges(n, AssignString, CurStyleName)
87			End If
88		Else
89			&apos; Style is not selected
90			If FindPartString(AssignString, &quot;&lt;SELECTED&gt;&quot;, &quot;&lt;/SELECTED&gt;&quot;, 1) = &quot;FALSE&quot; Then
91				DeselectStyle(CurStyleName, n)
92			End If
93		End If
94		IncreaseStatusvalue(SBRELGET/(LastIndex+1))
95	Next i
96End Sub
97
98
99Sub AssignCellFormatRanges(n as Integer, AssignString as String, CurStyleName as String)
100Dim oRanges() as Object
101Dim oRange as Object
102Dim oRangeAddress
103Dim oSheet as Object
104Dim StyleCellCount as Long
105Dim i as Integer
106Dim MaxIndex as Integer
107Dim RangeString as String
108Dim SheetName as String
109Dim RangeName as String
110Dim CellCountString as String
111	StyleCellCount = 0
112	RangeString = &quot;&lt;RANGES&gt;&quot;
113	MaxIndex = oSheets.Count-1
114	For i = 0 To MaxIndex
115		oSheet = oSheets(i)
116		SheetName = oSheet.Name
117		oRanges = osheet.CellFormatRanges.CreateEnumeration
118		While oRanges.hasMoreElements
119			oRange = oRanges.NextElement
120			If oRange.getPropertyState(&quot;NumberFormat&quot;) = 1 Then
121				If oRange.CellStyle = CurStyleName Then
122					oRangeAddress = oRange.RangeAddress
123					RangeName = RetrieveRangeNamefromAddress(oRange)
124					RangeString = RangeString &amp; RangeName &amp; &quot;,&quot;
125					StyleCellCount = StyleCellCount + CountRangeCells(oRange)
126				End If
127			End If
128		Wend
129	Next i
130	If StyleCellCount &gt; 0 Then
131		TotCellCount = TotCellCount + StyleCellCount
132		RangeString = RTrimStr(RangeString,&quot;,&quot;)
133		RangeString = RangeString &amp; &quot;&lt;/RANGES&gt;&quot;
134		CellCountString = &quot;&lt;CELLCOUNT&gt;&quot; &amp; StyleCellCount &amp; &quot;&lt;/CELLCOUNT&quot;
135		AssignString = ReplaceString(AssignString, RangeString,&quot;&lt;RANGES&gt;&lt;/RANGES&gt;&quot;)
136		AssignString = ReplaceString(AssignString, CellCountString,&quot;&lt;CELLCOUNT&gt;0&lt;/CELLCOUNT&gt;&quot;)
137	End If
138	AssignString = ReplaceString(AssignString, &quot;&lt;DEFINED&gt;TRUE&lt;/DEFINED&gt;&quot;, &quot;&lt;DEFINED&gt;FALSE&lt;/DEFINED&gt;&quot;)
139	StyleRangeAssignmentList(n)	= AssignString
140End Sub
141
142
143&apos; deletes a styletemplate from the Collection that selects the ranges
144Sub DeselectStyle(DeSelStyleName as String, n as Integer)
145Dim i as Integer
146Dim RangeName as String
147Dim SelectString as String
148Dim AssignString as String
149Dim StyleRangeList() as String
150Dim MaxIndex as Integer
151	SelectString =&quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;
152	AssignString = StyleRangeAssignmentList(n)
153	RangeString = FindPartString(AssignString,&quot;&lt;RANGES&gt;&quot;,&quot;&lt;/RANGES&gt;&quot;,1)
154	StyleRangeList() = ArrayoutofString(RangeString,&quot;,&quot;)
155	MaxIndex = Ubound(StyleRangeList())
156	For i = 0 To MaxIndex
157		RangeName = StyleRangeList(i)
158		If oSelRanges.HasbyName(RangeName) Then
159			oSelRanges.RemovebyName(RangeName)
160		End If
161	Next i
162	AssignString = ReplaceString(AssignString, &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;, &quot;&lt;SELECTED&gt;TRUE&lt;/SELECTED&gt;&quot;)
163	StyleRangeAssignmentList(n) = AssignString
164End Sub
165
166
167Function RetrieveRangeNamefromAddress(oRange as Object) as String
168Dim Rangename as String
169Dim oAddressRanges as Object
170	oAddressRanges = oDocument.createInstance(&quot;com.sun.star.sheet.SheetCellRanges&quot;)
171	oAddressRanges.InsertbyName(&quot;&quot;,oRange)
172	Rangename = oAddressRanges.RangeAddressesasString
173&apos;	Msgbox &quot;Adresse: &quot; &amp; oRangeAddress.StartColumn &amp; &quot; ; &quot; &amp; oRangeAddress.EndColumn &amp; &quot; ; &quot; &amp; oRangeAddress.StartRow &amp; &quot; ; &quot; &amp; oRangeAddress.EndRow &amp; chr(13) &amp; RangeName
174&apos;	oAddressRanges.RemovebyName(RangeName)
175	RetrieveRangeNamefromAddress = Rangename
176End Function
177
178
179&apos; creates a sheet object from an according sectionname
180Function RetrieveSheetoutofRangeName(TableText as String)
181Dim DescriptionList() as String
182Dim SheetName as String
183Dim MaxIndex as integer
184	&apos; find out in which sheet the range is
185	DescriptionList() = ArrayOutofString(TableText,&quot;.&quot;,MaxIndex)
186	SheetName = DescriptionList(0)
187	SheetName = DeleteStr(SheetName,&quot;&apos;&quot;)
188	&apos; set the viewcursor on this sheet
189	RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName)
190End Function
191
192
193&apos; creates a rangeobject from an according rangename
194Function RetrieveRangeoutofRangeName(TableText as String)
195	oSheet = RetrieveSheetoutofRangeName(TableText)
196	oRange = oSheet.GetCellRangebyName(TableText)
197	RetrieveRangeoutofRangeName = oRange
198End Function
199
200
201Sub ConvertTheSoftWay(StyleList(), bDeSelect as Boolean)
202Dim i as Integer
203Dim l as Integer
204Dim s as Integer
205Dim n as Integer
206Dim CurStyleName as String
207Dim RangeName as String
208Dim OldStatusValue as Integer
209Dim LastIndex as Integer
210Dim oSelListbox as Object
211Dim StyleRangeList() as String
212Dim MaxIndex as Integer
213	oSelListbox = DialogConvert.GetControl(&quot;lstSelection&quot;)
214	LastIndex = Ubound(StyleList())
215	OldStatusValue = StatusValue
216	For i = 0 To LastIndex
217		CurStyleName = StyleList(i)
218		oStyle = oStyles.GetbyName(CurStyleName)
219		StyleRangeList() = GetAssignedRanges(CurStyleName, n)
220		MaxIndex = Ubound(StyleRangeList())
221		For s = 0 To MaxIndex
222			RangeName = StyleRangeList(s)
223			oRange = RetrieveRangeoutofRangeName(RangeName)
224			If oRange.getPropertyState(&quot;NumberFormat&quot;) = 1 Then
225				&apos; Range is hard formatted
226				ConvertCellCurrencies(oRange)
227				CurCellCount = CountRangeCells(oRange)
228			End If
229			IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue))
230			If bDeSelect Then
231				&apos; Note: On Problems see Bug #73157
232				If oSelRanges.HasbyName(RangeName) Then
233					oSelRanges.RemovebyName(RangeName)
234					oDocument.CurrentController.Select(oSelRanges)
235				End If
236			End If
237		Next s
238		SwitchNumberFormat(ostyle, oFormats, sEuroSign)
239		StyleRangeAssignmentList(n) = &quot;&quot;
240		l = GetItemPos(oSelListBox.Model, CurStyleName)
241		oSelListbox.RemoveItems(l,1)
242	Next
243End Sub
244
245
246Function GetAssignedRanges(CurStyleName as String, n as Integer)
247Dim StyleRangeList() as String
248Dim RangeString as String
249Dim AssignString as String
250	n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
251	If n &lt;&gt; -1 Then
252		AssignString = StyleRangeAssignmentList(n)
253		RangeString = FindPartString(AssignString,&quot;&lt;RANGES&gt;&quot;, &quot;&lt;/RANGES&gt;&quot;,1)
254		If RangeString &lt;&gt; &quot;&quot; Then
255			StyleRangeList() = ArrayoutofString(RangeString,&quot;,&quot;)
256		End If
257	End If
258	GetAssignedRanges() = StyleRangeList()
259End Function</script:module>
260