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
|
<?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 = oDocument.DocumentInfo.MimeType
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
oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator
' Retrieve the indices for the cellformatations
oFormats = oDocument.NumberFormats
End Sub
Sub CloseDialog
Dim n, m as Integer
If Not bMacroStopped Then
bMacroStopped = True
DialogConvert.EndExecute
If Not DocDisposed Then
ReprotectSheets()
End If
Stop
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(), 1)
If RangeIndex > -1 Then
ConvertThehardWay(RangeList(), True, False)
MakeStyleEnumeration(True)
oDocument.calculateAll()
End If
ReprotectSheets()
bRangeListDefined = False
End If
Else
oStatusline.SetValue(10)
ConvertTextFields()
oStatusline.SetValue(80)
ConvertWriterTables()
End If
oStatusline.End
On Local Error Goto 0
End Function
Sub SwitchNumberFormat(oObject as Object, oFormats as object, sNewSymbol as String)
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 aLocLocale As New com.sun.star.lang.Locale
Dim i as Integer
Dim aNewStr as String
Dim iNumberFormat as Long
Dim AddToList as Boolean
' Numberformat mit dem neuen Symbol als Basis für generateFormat
aSimpleStr = "0 [$"+sNewSymbol+"]"
nSimpleKey = Numberformat(oFormats, aSimpleStr, oLocale)
On Local Error Resume Next
iNumberFormat = oObject.NumberFormat
If Err <> 0 Then
Msgbox "Error Reading the Number Format"
Resume CLERROR
End If
On Local Error GoTo NOKEY
aFormat() = oFormats.getByKey(iNumberFormat)
On Local Error GoTo 0
' Typ und Währungssymbol des Numberformats heraussuchen
' neues Währungsformat mit passenden Einstellungen setzen
nFormatDecimals = aFormat.Decimals
nFormatLeading = aFormat.LeadingZeros
bFormatNegRed = aFormat.NegativeRed
bFormatThousands = aFormat.ThousandsSeparator
aLocLocale = aFormat.Locale
aNewStr = oFormats.generateFormat( nSimpleKey, oLocale, _
bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)
oObject.NumberFormat = Numberformat(oFormats, aNewStr, aLocLocale)
NOKEY:
If Err <> 0 Then
Resume CLERROR
End If
CLERROR:
End Sub
Function Numberformat( oFormats as Object, aFormatStr as String, oLocale)
Dim nRetkey
nRetKey = oFormats.queryKey( aFormatStr, oLocale, True )
If nRetKey = -1 Then
nRetKey = oFormats.addNew( aFormatStr, oLocale )
If nRetKey = -1 Then nRetKey = 0
End If
Numberformat = nRetKey
End Function
' Funktion findet den Formattyp einer Vorlage, Zelle oder eines Bereiches heraus und schreibt das Ergebnis
' in die globale Variable nFormatType; Ist ein Währungssymbol gesetzt, wird dieses in den globalen String
' sFormatCurrency geschrieben.
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
' Typ und Währungssymbol des Numberformats heraussuchen
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(),1,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
' ToggleWindow(False)
Select Case DialogModel.Step
Case 1
If DialogModel.chkComplete.State = 1 Then
ConvertWholeDocument()
Else
ConvertRangesorStylesofDocument()
End If
Case 2
InitializeThirdStep()
ConvertDocuments()
Case 3
CloseDialog()
End Select
End Sub
Sub IncreaseStatusValue(AddStatusValue as Integer)
StatusValue = Int(StatusValue + AddStatusValue)
oStatusline.SetValue(StatusValue)
End Sub
Sub SelectCurrency()
Dim AddtoList as Boolean
Dim UpRangeList as Integer
Dim OldCurrIndex as Integer
OldCurrIndex = CurrIndex
CurrIndex = DialogModel.lstCurrencies.SelectedItems(0)
InitializeCurrencyValues(CurrIndex)
CurExtension(0) = LangIDValue(CurrIndex,0,2)
CurExtension(1) = LangIDValue(CurrIndex,1,2)
If DialogModel.Step = 1 Then
If OldCurrIndex = -1 Then
DialogModel.chkComplete.State = 1
EnableStep1DialogControls(True,False, True)
SetOptionValuestoNull()
Else
EnableStep1DialogControls(False,False, False)
If DialogModel.optCellTemplates.State = 1 Then
EnableStep1DialogControls(False, False, False)
CreateStyleEnumeration()
EnableStep1DialogControls(True, True, True)
ElseIf ((DialogModel.optSheetRanges.State = 1) OR (DialogModel.optDocRanges.State = 1)) AND (DialogModel.Step = 1) Then
UpRangeList = UBound(RangeList())
ReDim RangeList(UpRangeList) 'as String
CreateRangeEnumeration(False)
ElseIf DialogModel.optSelRange.State= 1 Then
'Preselected Range
CheckRangeSelection()
End If
EnableStep1DialogControls(True, True, True)
End If
ElseIf DialogModel.Step = 2 Then
EnableStep2DialogControls(True)
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
oStatusline.Start(sStsPROGRESS,100) '"Konvertierungsfortschritt:"
StatusValue = 0
End Sub</script:module>
|
