Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Word > VBA Word
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 17/12/2007, 17h26   #1
Invité de passage
 
Inscription : novembre 2007
Messages : 9
Détails du profil
Informations forums :
Inscription : novembre 2007
Messages : 9
Points : 0
Points : 0
Par défaut Macro de conversion

Bonjour
j'ai une macro que j'ai récuperé sous un format .sxw pour convertir un document openoffice en syntaxe dokuwiki. J'ai copié integralement le code de la macro dans un module aprés avoir fait outils---> 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 OpenOffice
voici le code intégré dans un module

Code :
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
444
 
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
ediawara est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 17/12/2007, 17h37   #2
Responsable Word

 
Avatar de Heureux-oli
 
Homme Olivier Lebeau
Contrôleur d'industrie
Inscription : février 2006
Messages : 17 354
Détails du profil
Informations personnelles :
Nom : Homme Olivier Lebeau
Âge : 47
Localisation : Belgique

Informations professionnelles :
Activité : Contrôleur d'industrie
Secteur : Aéronautique - Marine - Espace - Armement

Informations forums :
Inscription : février 2006
Messages : 17 354
Points : 29 270
Points : 29 270
Les deux suites office n'utilisent pas le même langage !

Normal que ça ne fonctionne pas !
__________________
J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
Débutez en VBA

Mes articles


Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !
Heureux-oli est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 17/12/2007, 23h38   #3
Invité de passage
 
Inscription : novembre 2007
Messages : 9
Détails du profil
Informations forums :
Inscription : novembre 2007
Messages : 9
Points : 0
Points : 0
Par défaut macro de conversion

ca je m'en doute pas qu'il y'a quelques differences
là je pensais qu'il serait possible de faire quelques ameliorations pour que ca tourne avec sous word
ediawara est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 18/12/2007, 07h57   #4
Responsable Word

 
Avatar de Heureux-oli
 
Homme Olivier Lebeau
Contrôleur d'industrie
Inscription : février 2006
Messages : 17 354
Détails du profil
Informations personnelles :
Nom : Homme Olivier Lebeau
Âge : 47
Localisation : Belgique

Informations professionnelles :
Activité : Contrôleur d'industrie
Secteur : Aéronautique - Marine - Espace - Armement

Informations forums :
Inscription : février 2006
Messages : 17 354
Points : 29 270
Points : 29 270
Citation:
Envoyé par ediawara Voir le message
ca je m'en doute pas qu'il y'a quelques differences
là je pensais qu'il serait possible de faire quelques ameliorations pour que ca tourne avec sous word
C'est pas quelques différences, le language utilisé n'est absolument pas le même ! Sous OOo, on utilise JAVA alors que sous MS Office, on utilise VBA, le seul point commun, c'est que ce sont des langages de programmation.
__________________
J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
Débutez en VBA

Mes articles


Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !
Heureux-oli est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 18/12/2007, 11h31   #5
Invité de passage
 
Inscription : novembre 2007
Messages : 9
Détails du profil
Informations forums :
Inscription : novembre 2007
Messages : 9
Points : 0
Points : 0
Merci pour cette réponse j'en vois un peu plus clair
ediawara est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 07h26.


 
 
 
 
Partenaires

Hébergement Web