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
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
|
<?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="Common" script:language="StarBasic"> REM ***** BASIC *****
Public DialogModel as Object
Public DialogConvert as Object
Public DialogPassword as Object
Public PasswordModel as Object
Sub RetrieveDocumentObjects()
CurMimeType = Tools.GetDocumentType(oDocument)
If Instr(1, CurMimeType, "calc") <> 0 Then
oSheets = oDocument.Sheets
oSheet = oDocument.Sheets.GetbyIndex(0)
oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
End If
' Retrieve the indices for the cellformatations
oFormats = oDocument.NumberFormats
End Sub
Sub CancelTask()
' If Not DocDisposed Then
' ReprotectSheets()
' End If
If DialogModel.Step = 3 And (Not bCancelTask) Then
If Msgbox(sMsgCancelConversion, 36, sMsgCancelTitle) = 6 Then
bCancelTask = True
DialogConvert.EndExecute
Else
bCancelTask = False
End If
Else
DialogConvert.EndExecute()
End If
End Sub
Function ConvertDocument()
GoOn = True
' DocDisposed = True
InitializeProgressbar()
If Instr(1, CurMimeType, "calc") <> 0 Then
bDocHasProtectedSheets = CheckSheetProtection(oSheets)
If bDocHasProtectedSheets Then
bDocHasProtectedSheets = UnprotectSheetsWithPassword(oSheets, bDoUnProtect)
End If
If Not bDocHasProtectedSheets Then
If Not bRangeListDefined Then
TotCellCount = 0
CreateRangeEnumeration(True)
Else
IncreaseStatusvalue(SBRelGet/3)
End If
RangeIndex = Ubound(RangeList())
If RangeIndex > -1 Then
ConvertThehardWay(RangeList(), True, False)
MakeStyleEnumeration(True)
oDocument.calculateAll()
End If
ReprotectSheets()
bRangeListDefined = False
End If
Else
DialogModel.ProgressBar.ProgressValue = 10 ' oStatusline.SetValue(10)
ConvertTextFields()
DialogModel.ProgressBar.ProgressValue = 80 ' oStatusline.SetValue(80)
ConvertWriterTables()
End If
EndStatusLine()
On Local Error Goto 0
End Function
Sub SwitchNumberFormat(oObject as Object, oFormats as object)
Dim nFormatLanguage as Integer
Dim nFormatDecimals as Integer
Dim nFormatLeading as Integer
Dim bFormatLeading as Integer
Dim bFormatNegRed as Integer
Dim bFormatThousands as Integer
Dim i as Integer
Dim aNewStr as String
Dim iNumberFormat as Long
Dim AddToList as Boolean
Dim sOldCurrSymbol as String
On Local Error Resume Next
iNumberFormat = oObject.NumberFormat
On Local Error GoTo NOKEY
aFormat() = oFormats.getByKey(iNumberFormat)
On Local Error GoTo 0
sOldCurrSymbol = aFormat.CurrencySymbol
If sOldCurrSymbol = CurrValue(CurrIndex,5) Then
aSimpleStr = "0 [$EUR]"
Else
aSimpleStr = "0 [$" & sEuroSign & aFormat.CurrencyExtension & "]"
End If
nSimpleKey = Numberformat(oFormats, aSimpleStr, oLocale)
' set new Currency format with according settings
nFormatDecimals = 2
nFormatLeading = aFormat.LeadingZeros
bFormatNegRed = aFormat.NegativeRed
bFormatThousands = aFormat.ThousandsSeparator
aNewStr = oFormats.generateFormat( nSimpleKey, aFormat.Locale, bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)
oObject.NumberFormat = Numberformat(oFormats, aNewStr, aFormat.Locale)
NOKEY:
If Err <> 0 Then
Resume CLERROR
End If
CLERROR:
End Sub
Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Object)
Dim nRetkey
Dim l as String
Dim c as String
nRetKey = oFormats.queryKey( aFormatStr, oLocale, True )
If nRetKey = -1 Then
l = oLocale.Language
c = oLocale.Country
nRetKey = oFormats.addNew( aFormatStr, oLocale )
If nRetKey = -1 Then nRetKey = 0
End If
Numberformat = nRetKey
End Function
Function CheckFormatType( FormatObject as object)
Dim i as Integer
Dim LocCurrIndex as Integer
Dim nFormatFormatString as String
Dim FormatLangID as Integer
Dim sFormatCurrExt as String
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
If NOT INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY Then
CheckFormatType = False
Exit Function
End If
If FieldinArray(CurrSymbolList(),2,oFormatofObject.CurrencySymbol) Then
' If the Currencysymbol of the object ist the one needed, then check the Currency extension
sFormatCurrExt = oFormatofObject.CurrencyExtension
If FieldInList(CurExtension(),2,sFormatCurrExt) Then
' The Currency - extension also fits
CheckFormatType = True
Else
' The Currency - symbol is Euro-conforming (like 'DEM'), so there is no Currency-Extension
CheckFormatType = oFormatofObject.CurrencySymbol = CurrsymbolList(2)
End If
Else
' The Currency Symbol of the object is not the desired one
If oFormatofObject.CurrencySymbol = "" Then
' Format is "automatic"
CheckFormatType = CheckLocale(oFormatofObject.Locale)
Else
CheckFormatType = False
End If
End If
NOKEY:
If Err <> 0 Then
CheckFormatType = False
Resume CLERROR
End If
CLERROR:
End Function
Sub StartConversion()
GoOn = True
Select Case DialogModel.Step
Case 1
If DialogModel.chkComplete.State = 1 Then
ConvertWholeDocument()
Else
ConvertRangesorStylesofDocument()
End If
Case 2
bCancelTask = False
If InitializeThirdStep() Then
ConvertDocuments()
bCancelTask = True
End If
Case 3
DialogConvert.EndExecute()
End Select
End Sub
Sub IncreaseStatusValue(AddStatusValue as Integer)
StatusValue = Int(StatusValue + AddStatusValue)
If DialogModel.Step = 3 Then
DialogModel.ProgressBar.ProgressValue = StatusValue
Else
oStatusline.SetValue(StatusValue)
End If
End Sub
Sub SelectCurrency()
Dim AddtoList as Boolean
Dim NullList()
Dim OldCurrIndex as Integer
bRangeListDefined = False
OldCurrIndex = CurrIndex
CurrIndex = DialogModel.lstCurrencies.SelectedItems(0)
If OldCurrIndex <> CurrIndex Then
InitializeCurrencyValues(CurrIndex)
CurExtension(0) = LangIDValue(CurrIndex,0,2)
CurExtension(1) = LangIDValue(CurrIndex,1,2)
CurExtension(2) = LangIDValue(CurrIndex,2,2)
If DialogModel.Step = 1 Then
EnableStep1DialogControls(False,False, False)
If DialogModel.optCellTemplates.State = 1 Then
EnableStep1DialogControls(False, False, False)
CreateStyleEnumeration()
ElseIf ((DialogModel.optSheetRanges.State = 1) OR (DialogModel.optDocRanges.State = 1)) AND (DialogModel.Step = 1) Then
CreateRangeEnumeration(False)
If Ubound(RangeList()) = -1 Then
DialogModel.lstSelection.StringItemList() = NullList()
End If
ElseIf DialogModel.optSelRange.State= 1 Then
'Preselected Range
End If
EnableStep1DialogControls(True, True, True)
ElseIf DialogModel.Step = 2 Then
EnableStep2DialogControls(True)
End If
End If
End Sub
Sub FillUpCurrencyListbox()
Dim i as Integer
Dim MaxIndex as Integer
MaxIndex = Ubound(CurrValue(),1)
Dim LocList(MaxIndex) as String
For i = 0 To MaxIndex
LocList(i) = CurrValue(i,0)
Next i
DialogModel.lstCurrencies.StringItemList() = LocList()
If CurrIndex > -1 Then
SelectListboxItem(DialogModel.lstCurrencies, CurrIndex)
End If
End Sub
Sub InitializeProgressbar()
CurCellCount = 0
If Not IsNull(oStatusLine) Then
oStatusline.Start(sStsPROGRESS, 100)
Else
DialogModel.ProgressBar.ProgressValue = 0
End If
StatusValue = 0
End Sub
Sub EndStatusLine()
If Not IsNull(oStatusLine) Then
oStatusline.End
Else
DialogModel.ProgressBar.ProgressValue = 100
End If
End Sub
</script:module>
|