Bonjour j'ai une macro que j'ai récuperer pour convertir un document openoffice en syntaxe dokuwiki. J'ai copié integralement le code de la macro dans un module aprés avoir fait outiles---> macro--->nouvelle macro et j'ai copié le code. Sauf que ca ne fonctionne pas quand je le lance sous microsoft word alors que ca marche trés bien avec sous OpenOffice
je me suis pencher dessus mais j'ai rien trouver
voici le code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
Const sBOLDSTART = "**"
Const sBOLDEND = "**"
Const sUNDERSTART = "__"
Const sUNDEREND = "__"
Const sITALICSTART = "//"
Const sITALICEND = "//"
Const sMONOSTART = "''"
Const sMONOEND = "''"
Const sSUPERSTART = "<sup>"
Const sSUPEREND = "</sup>"
Const sSUBSTART = "<sub>"
Const sSUBEND = "</sub>"
Const sDELSTART = "<del>"
Const sDELEND = "</del>"
Const sFOOTSTART = "(("
Const sFOOTEND = "))"
Const sHEADCHAR = "="
Const sHORIZLINE = "----"
Const sTABLESEP = "|"
Const sTABLEHEADSEP = "^"
Const sNEWLINE = "\\ "
Const sLITERALSTART = "%%"
Const sLITERALEND = "%%"
Const sORDEREDLIST = "-"
Const sUNORDEREDLIST = "*"
Const sHYPERSTART = "[["
Const sHYPEREND = "]]"
Const sPICTURESTART = "{{wiki:"
Const sPICTUREEND = "}}"
Const sCODESTART = "<code "
 
Const sDEFAULTCODE = "oobas"
 
Private sLineEnd As String
 
Private s As String
Private oVC
Private bInCode As Boolean
Private mCodes
 
'This routine processes all html files in a directory tree.
Sub Folders()
Dim mTextFile(0)
 
mTextFile(0) = createUnoStruct("com.sun.star.beans.PropertyValue")
mTextFile(0).name = "FilterName"
mTextFile(0).Value = "Text"
 
basicLibraries.loadLibrary ("Tools")
'ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean,  bcheckFileType as Boolean, bGetByTitle as Boolean, Optional sFileContent(), Optional sExtension as String)
mFiles = ReadDirectories("/var/www/html/dokuwiki/data/ref", True, False, False, , "html")
 
'sStart = "file:///var/www/html/dokuwiki/data/"
'nStart = len(sStart) + 1
 
For i = 0 To UBound(mFiles)
        sFile = mFiles(i)
        If RIGHT(sFile, 5) = ".html" Then
        oSourceDoc = StarDesktop.loadComponentFromURL(sFile, "_blank", 0, array())
        oText = oSourceDoc.text
 
        oDestDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, array())
        oDestText = oDestDoc.getText()
'       oCursor = oDestText.createTextCursor()
        oVC = oDestDoc.CurrentController.viewCursor
        subDokuWiki (oText)
 
'       oVC.text.insertString(oVC.text.end, "[[http://api.openoffice.org/docs/common/" & mid(sFile, nStart) & "]]", false)
        oDestDoc.storeAsUrl(left(sFile,len(sFile)-4) & "txt", mTextFile())
        oDestDoc.close (True)
 
        oSourceDoc.close (False)
'       kill sFile      'Uncomment this line to remove the original file
        End If
Next
End Sub
 
 
'This is the main routine to run on the currently open document
Sub DokuWiki()
oSourceDoc = thisComponent
oDestDoc = fnDokuWiki(oSourceDoc)
'oDestDoc.close(false)
End Sub
 
 
Function fnDokuWiki(oSourceDoc)
oText = oSourceDoc.text
'Create a new document
oNewDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, array())
oNewText = oNewDoc.getText()
oCursor = oNewText.createTextCursor()
'oNewText.insertString(oCursor,sDokuWiki , true)
oVC = oNewDoc.CurrentController.viewCursor
mCodes = array("actionscript", "ada", "apache", "asm", "asp", "bash", "caddcl", "cadlisp", "c_mac", "cpp", "csharp", _
 "css", "delphi", "html4strict", "javascript", "java", "lisp", "lua", "nsis", "objc", "oobas", "pascal", "perl", _
 "php-brief", "php", "python", "qbasic", "smarty", "sql", "vbnet", "vb", "visualfoxpro", "xml", "c")
 
subDokuWiki (oText)
 
'Copy to clipboard
'There is a way of doing this via the API but this will do
oVC.gotoStart (False)
oVC.gotoEnd (True)
oFrame = oNewDoc.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:Copy", "", 0, array())
 
 
fnDokuWiki = oNewDoc
End Function
 
 
Sub subDokuWiki(oText)
sLineEnd = chr(10)
 
'If not oDoc.supportsService("com.sun.star.text.TextDocument") then
'       msgBox "Sorry - I can only create DokuWiki documents out of text documents", 16, "Error"
'       exit function
'end if
s = ""
oEnum1 = oText.createEnumeration
' loop over all paragraphs
While oEnum1.hasMoreElements
        oTextElement = oEnum1.nextElement
        If oTextElement.supportsService("com.sun.star.text.Paragraph") Then
                subParagraph (oTextElement)
        ElseIf oTextElement.supportsService("com.sun.star.text.TextTable") Then
                subTable (oTextElement)
        End If
Wend
If bInCode Then
        subAddString ("</code>" & sLineEnd)
End If
End Sub
 
 
Sub subParagraph(oTextElement)
nHeadLevel = oTextElement.ParaChapterNumberingLevel + 1
bInList = False
sCode = oTextElement.ParaStyleName
sCode = fnInCode(sCode)
If bInCode And sCode = "" Then
        subAddString ("</code>" & sLineEnd)
        bInCode = False
End If
If nHeadLevel >= 1 And nHeadLevel <= 5 Then
        sHead = string(7 - nHeadLevel, sHEADCHAR)
        subAddString (sLineEnd & sHead & oTextElement.string & sHead & sLineEnd)
ElseIf sCode <> "" Then
        If Not bInCode Then
                subAddString (sCODESTART & sCode & ">" & sLineEnd)
                bInCode = True
        End If
        subAddString (oTextElement.string & sLineEnd)
Else
        If oTextElement.NumberingIsNumber Then 'if not isEmpty(oTextElement.NumberingLevel) then
        '       xray.xray oTextElement
                bInList = True
                subAddString (string((oTextElement.NumberingLevel + 1) * 2, " "))
                If InStr("0123456789", left(oTextElement.string, 1)) > 0 Then
                        subAddString (sORDEREDLIST)
                Else
                        subAddString (sUNORDEREDLIST)
                End If
        End If
        oEnum2 = oTextElement.createEnumeration
        ' loop over all text portions
        While oEnum2.hasMoreElements
                oTextPortion = oEnum2.nextElement
                subAddString (fnTextPortion(oTextPortion, False))
        Wend
        subAddString (sLineEnd)
        If oTextElement.bottomBorder.OuterLineWidth > 0 Then
                subAddString (sHORIZLINE & sLineEnd)
        Else
                If Not bInList Then subAddString (sLineEnd)
        End If
End If
End Sub
 
 
Sub subTable(oTable)
mCellNames = oTable.getCellNames
 
nmaxCols = 0
For i = 0 To UBound(mCellNames)
        sCellName = mCellNames(i)
        nCol = 0
        For j = 1 To Len(sCellName)
                ch = mid(sCellName, j, 1)
                Select Case ch
                Case "A" To "Z"
                        nCol = nCol * 26 + (asc(ch) - asc("A"))
                Case "0" To "9"
                        'nRow = val(mid(sCellName, j)) - 1
                        Exit For
                End Select
        Next
        If nCol > nmaxCols Then nmaxCols = nCol
Next
 
nRows = oTable.rows.count - 1
 
If nmaxCols = 0 Then
        For i = 0 To nRows
                oCell = oTable.getCellByPosition(0, i)
                oCellEnum = oCell.createEnumeration
                While oCellEnum.hasMoreElements
                        subParagraph (oCellEnum.nextElement)
                Wend
        Next
        Exit Sub
End If
 
Dim mCells(nRows, nmaxCols)
 
'for i = 0 to nRows
'       for j = 0 to nmaxCols - 1
'               mCells(i, j) = ""
'       next
'next
 
For i = 0 To UBound(mCellNames)
        sCellName = mCellNames(i)
        nCol = 0
        For j = 1 To Len(sCellName)
                ch = mid(sCellName, j, 1)
                Select Case ch
                Case "A" To "Z"
                        nCol = nCol * 26 + (asc(ch) - asc("A"))
                Case "0" To "9"
                        nRow = val(mid(sCellName, j)) - 1
                        Exit For
                End Select
        Next
        oCell = oTable.getCellByName(sCellName)
        sCell = " "
        oCellEnum = oCell.createEnumeration
        While oCellEnum.hasMoreElements
                oTextElement = oCellEnum.nextElement
                If sCell <> " " Then
                        sCell = sCell & sNEWLINE
                End If
 
                If oTextElement.ParaStyleName = "Table Heading" Then
                        sSep = sTABLEHEADSEP
                Else
                        sSep = sTABLESEP
                End If
 
                If oTextElement.NumberingIsNumber Then
                        If InStr("0123456789", left(oTextElement.string, 1)) > 0 Then
                                sCell = sCell & str(val(oTextElement.string))
                        Else
                                sCell = sCell & "* "
                        End If
                End If
 
                oPortionEnum = oTextElement.createEnumeration
                While oPortionEnum.hasMoreElements
                        oTextPortion = oPortionEnum.nextElement
                        sCell = sCell & fnTextPortion(oTextPortion, True)
                Wend
        Wend
        sCell = trim(sCell)
        Select Case oTextElement.paraAdjust
        Case com.sun.star.style.ParagraphAdjust.CENTER
                sCell = "  " & sCell & "  "
        Case com.sun.star.style.ParagraphAdjust.RIGHT
                sCell = "  " & sCell
        End Select
        mCells(nRow, nCol) = sCell
Next
 
For i = 0 To nRows
        sRow = ""
        sRow = sRow & sTABLESEP
        bHeading = False
        For j = 0 To nmaxCols
                If mCells(i, j) <> "" Then
                        If j = 0 And InStr(mCells(i, j), chr(10)) = 0 Then
                                bHeading = True
                        Else
                                bHeading = False
                        End If
                End If
                sRow = sRow & mCells(i, j) & sTABLESEP
        Next
        If bHeading Then
                If i = 0 Then
                        sRow = string(6, sHEADCHAR) & mCells(i, 0) & string(6, sHEADCHAR) & sLineEnd & sLineEnd
                Else
                        sRow = string(5, sHEADCHAR) & mCells(i, 0) & string(5, sHEADCHAR) & sLineEnd & sLineEnd
                End If
        Else
                sRow = sRow & sLineEnd
        End If
 
        subAddString (sRow)
Next
 
subAddString (sLineEnd)
End Sub
 
 
Function fnTextPortion(oTextPortion, bInTable As Boolean)
 
If Not isNull(oTextPortion.footnote) Then
        fnTextPortion = sFOOTSTART & oTextPortion.footnote.string & sFOOTEND
ElseIf oTextPortion.hyperlinkURL <> "" Then
        'NB: If the link has separate text portions (i.e. formats inside it) this will repeat the link :(
        fnTextPortion = sHYPERSTART & fnHyperConvert(oTextPortion.hyperlinkURL) & sTABLESEP & oTextPortion.string & sHYPEREND
ElseIf oTextPortion.TextPortionType = "Frame" Then
        'The above condition may need to be tightened
        sName = oTextPortion.createContentEnumeration("com.sun.star.text.TextContent").nextElement.name
        If sName <> "" Then
                fnTextPortion = sPICTURESTART & sName & sPICTUREEND
        End If
Else
        sPortion = oTextPortion.string
        If sPortion = "" Then
                fnTextPortion = ""
                Exit Function
        End If
        If bInTable Then
                'In case the separators are actually in the text of the table
                mSplits = split(sPortion, sTABLESEP)
                sPortion = join(mSplits, sLITERALSTART & sTABLESEP & sLITERALEND)
                mSplits = split(sPortion, sTABLEHEADSEP)
                sPortion = join(mSplits, sLITERALSTART & sTABLEHEADSEP & sLITERALEND)
        Else
                'In the unlikley event of a paragraph starting and finishing with separator characters.
                sFirstChar = left(sPortion, 1)
                If sFirstChar = sTABLESEP Or sFirstChar = sTABLEHEADSEP Then
                        sPortion = sLITERALSTART & sFirstChar & sLITERALEND & mid(sPortion, 2)
                End If
        End If
        'Convert smart quotes
        mSplits = split(sPortion, "“")
        sPortion = join(mSplits, chr(34))
        mSplits = split(sPortion, "”")
        sPortion = join(mSplits, chr(34))
        mSplits = split(sPortion, "‘")
        sPortion = join(mSplits, "'")
        mSplits = split(sPortion, "’")
        sPortion = join(mSplits, "'")
        'Convert em dashes
        mSplits = split(sPortion, "–")
        sPortion = join(mSplits, "-")
        'In case the text holds any of the formatting charaters make sure that they are treated literally
        mSplits = split(sPortion, sBOLDSTART)
        sPortion = join(mSplits, sLITERALSTART & sBOLDSTART & sLITERALEND)
        mSplits = split(sPortion, sUNDERSTART)
        sPortion = join(mSplits, sLITERALSTART & sUNDERSTART & sLITERALEND)
        mSplits = split(sPortion, sITALICSTART)
        sPortion = join(mSplits, sLITERALSTART & sITALICSTART & sLITERALEND)
        mSplits = split(sPortion, sMONOSTART)
        sPortion = join(mSplits, sLITERALSTART & sMONOSTART & sLITERALEND)
        mSplits = split(sPortion, sSUPERSTART)
        sPortion = join(mSplits, sLITERALSTART & sSUPERSTART & sLITERALEND)
        mSplits = split(sPortion, sSUBSTART)
        sPortion = join(mSplits, sLITERALSTART & sSUBSTART & sLITERALEND)
        mSplits = split(sPortion, sDELSTART)
        sPortion = join(mSplits, sLITERALSTART & sDELSTART & sLITERALEND)
        mSplits = split(sPortion, sFOOTSTART)
        sPortion = join(mSplits, sLITERALSTART & sFOOTSTART & sLITERALEND)
        mSplits = split(sPortion, sPICTURESTART)
        sPortion = join(mSplits, sLITERALSTART & sPICTURESTART & sLITERALEND)
        mSplits = split(sPortion, sCODESTART)
        sPortion = join(mSplits, sLITERALSTART & sCODESTART & sLITERALEND)
        mSplits = split(sPortion, sLineEnd)
        sPortion = join(mSplits, sNEWLINE & " ")
 
        'This is not very elegant as it will produce **bold**//**bold & italic**//
        'rather than **bold//bold & italic//**
        If oTextPortion.charWeight > 100 Then sPortion = sBOLDSTART & sPortion & sBOLDEND
        If oTextPortion.charPosture > 0 Then sPortion = sITALICSTART & sPortion & sITALICEND
        If oTextPortion.charUnderline > 0 Then sPortion = sUNDERSTART & sPortion & sUNDEREND
        If oTextPortion.charFontPitch = com.sun.star.awt.FontPitch.FIXED Then sPortion = sMONOSTART & sPortion & sMONOEND
        If oTextPortion.charEscapement > 0 Then sPortion = sSUPERSTART & sPortion & sSUPEREND
        If oTextPortion.charEscapement < 0 Then sPortion = sSUBSTART & sPortion & sSUBEND
        If oTextPortion.charStrikeOut > 0 Then sPortion = sDELSTART & sPortion & sDELEND
        fnTextPortion = sPortion
End If
End Function
 
 
Function fnHyperConvert(sURL As String) As String
Const sINTLINK = "doku.php?id="
 
'sIDL = "vnd.sun.star.help://sbasic/text/sbasic/shared/"
'sGuide = "file:///var/www/html/dokuwiki/DevelopersGuide"
'nIDL = len(sIDL)
'nGuide = len(sGuide)
nStartInternalLink = InStr(sURL, sINTLINK)
If nStartInternalLink > 0 Then
        nStartInternalLink = nStartInternalLink + Len(sINTLINK)
        fnHyperConvert = mid(sURL, nStartInternalLink)
'elseif sIDL = left(sURL, nIDL) then
'       sTemp = mid(sURL, nIDL + 1)
'       sTemp = left(stemp,(instr(sTemp, ".xhp")-1))
'       mSplits = split(sTemp, ".html")
'       sTemp = join(mSplits, "")
'       mSplits = split(sTemp, "/")
        fnHyperConvert = sTemp  'join(mSplits, ":")
'elseif left(sURL, nGuide) = sGuide then
'       sTemp = "http://api.openoffice.org/docs/DevelopersGuide" & mid(sURL, nGuide + 1)
'       mSplits = split(sTemp, ".xhtml")
'       fnHyperConvert = join(mSplits, ".htm")
Else
        fnHyperConvert = sURL
End If
End Function
 
 
Function fnInCode(sParaStyleName)
nCode = InStr(1, sParaStyleName, "Code")
 
If nCode > 0 Then
        nCode = nCode + 4
        For i = 0 To UBound(mCodes)
                If InStr(nCode, sParaStyleName, mCodes(i)) > 0 Then
                        fnInCode = mCodes(i)
                        Exit For
                End If
        Next
ElseIf sParaStyleName = "Preformatted Text" Then
        fnInCode = sDEFAULTCODE
Else
        fnInCode = ""
End If
End Function
 
 
Sub subAddString(sAdd As String)
 
If sAdd = sLineEnd Then 'A paragraph can't be > 64k therefore this hack makes sure of some paragraph breaks
        oVC.text.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
Else
        oVC.text.insertString(oVC, sAdd , false)
End If
End Sub