Importing formatted text from MS Word
Hello guys,
Unlike the standard newbie, I will try not to ask any question about the contemplated timeframe for the implementation of the WYSIWIG editor. ;-)
However I really needed a way to import a lot of formatted text from MS Word, so this is the temporary solution I found: I created two small macros in Visual Basic to do the task automatically.
The first one, ConvertWordToWikidot, processes the selection and copies the selected text to the clipboard after having converted the formatting to Wikidot syntax. The second one, ConvertClipboardToWikidot, does the same but uses the text already in the clipboard instead of the selection.
I am aware of the fact that the code is not very elegant and that the functionnalities are so far limited (it only supports italic, bold and underlined characters as well as very simple bullet lists). However I thought that it was worth making it public in case it could help somebody else.
Please let me know if you improve it or have any question!
Best regards,
Rafaël
Attribute VB_Name = "Wikidot"
Option Explicit
Sub ConvertWordToWikidot()
'This macro copies the selected text to the clipboard
'after having converted the formatted text into Wikidot syntax
'
'Only some formattings are recognised at this stage
Dim dest, p As Paragraph, r As Range, r2 As Range, s As Range, SU
'You must select text to use the macro
If Selection.Type <> wdSelectionNormal Then Exit Sub
Set s = Selection.Range
'Stop screen refreshing unless called by another sub which has already disabled screen refreshing
If Application.ScreenUpdating = False Then
SU = False
Else
Application.ScreenUpdating = False
SU = True
End If
'Copy the selected text to the end of the document. This is where
'the formatted text will be processed.
Set r = ActiveDocument.Range
dest = r.End - 1 'Remember where the end of the document is at the beginning of the macro
r.Start = dest 'Let r start at the end of the document
Selection.Copy
r.Paste
'Convert italic text to //xxx//
r.Start = dest
r.End = ActiveDocument.Range.End - 1
r.Find.ClearFormatting
r.Find.Font.Italic = True
Do While r.Find.Execute = True
r.Font.Italic = False
If r.Characters.Last = Chr(13) Or r.Characters.Last = Chr(11) Then r.End = r.End - 1 'If a paragraph mark is the last character, insert text before it
If r.Characters.Last = " " Then r.End = r.End - 1 'If a space is the last character, insert text before it
If r.Characters.First = " " Then r.Start = r.Start + 1 'If a space is the first character, insert text after it
r.InsertBefore "//"
r.InsertAfter "//"
r.End = ActiveDocument.Range.End 'Continue until the end of the document
Loop
'Convert bold text to **xxx**
r.Start = dest
r.End = ActiveDocument.Range.End - 1
r.Find.ClearFormatting
r.Find.Font.Bold = True
Do While r.Find.Execute = True
r.Font.Bold = False
If r.Characters.Last = Chr(13) Or r.Characters.Last = Chr(11) Then r.End = r.End - 1 'If a paragraph mark is the last character, insert text before it
If r.Characters.Last = " " Then r.End = r.End - 1 'If a space is the last character, insert text before it
If r.Characters.First = " " Then r.Start = r.Start + 1 'If a space is the first character, insert text after it
r.InsertBefore "**"
r.InsertAfter "**"
r.End = ActiveDocument.Range.End 'Continue until the end of the document
Loop
'Convert underlined text to __xxx__
r.Start = dest
r.End = ActiveDocument.Range.End - 1
r.Find.ClearFormatting
r.Find.Font.Underline = wdUnderlineSingle
Do While r.Find.Execute = True
r.Font.Underline = wdUnderlineNone
If r.Characters.Last = Chr(13) Or r.Characters.Last = Chr(11) Then r.End = r.End - 1 'If a paragraph mark is the last character, insert text before it
If r.Characters.Last = " " Then r.End = r.End - 1 'If a space is the last character, insert text before it
If r.Characters.First = " " Then r.Start = r.Start + 1 'If a space is the first character, insert text after it
r.InsertBefore "__"
r.InsertAfter "__"
r.End = ActiveDocument.Range.End 'Continue until the end of the document
Loop
'Convert bullet point paragraph by inserting "*" at the beginning of it
'If the bullet is shifted to the right (sub-bullet), insert a space before the "*"
'If there is a breakline (not a paragraph mark) in the bullet paragraph,
'insert a left margin of 1cm
If s.Paragraphs.Count >= 2 Or s.Characters.Last = Chr(13) Then 'Do not do anything if at least a whole paragraph has been selected
r.Start = dest
r.End = ActiveDocument.Range.End - 1
For Each p In r.Paragraphs
'First, turn paragraphs into bullets
If (p.Range.ListFormat.ListType = wdListBullet) Or (p.Range.ListFormat.ListType = wdListSimpleNumbering) Then
' Remark: Normally the comparison wdListBullet should be enough.
' However I also want to convert Simple Numbering to Wikidot bullets
' To avoid this, just suppress "Or (p.Range.ListFormat.ListType = wdListSimpleNumbering)"
If p.LeftIndent <= CentimetersToPoints(0.4) Then
p.Range.InsertBefore "* "
Else
p.Range.InsertBefore " * "
End If
End If
'Second, increase left margin when there is a breakline
Set r2 = p.Range
If r2.Find.Execute(FindText:=Chr(11)) = True Then
r2.InsertAfter "[[div style=""margin-left: 1cm""]]" & Chr(11)
Set r2 = ActiveDocument.Range(Start:=(p.Range.End - 1), End:=(p.Range.End) - 1)
r2.InsertAfter Chr(11) & "[[/div]]"
End If
Next p
End If
'Clear the remaining formatting of the converted text, copy it
'to the clipboard and delete it
r.Start = dest
r.End = ActiveDocument.Range.End - 1
r.Select
Selection.ClearFormatting
Selection.Cut
s.Select
'Update screen unless called by another sub which has already disabled screen refreshing
If SU = True Then
Application.ScreenUpdating = True
Application.ScreenRefresh
End If
End Sub
Sub ConvertClipboardToWikidot()
'This macro converts the formatted text copied into the clipboard
'after having converted it into Wikidot syntax
'
'Only some formattings are recognised at this stage
Dim r As Range
Application.ScreenUpdating = False
Set r = ActiveDocument.Range(Start:=ActiveDocument.Range.End - 1, End:=ActiveDocument.Range.End - 1)
r.Paste
r.Select
ConvertWordToWikidot
r.Delete
Application.ScreenUpdating = True
Application.ScreenRefresh
End Sub
