' Macro pour convertir un document Microsoft Word 97 au format SPIP 1.3
' "Document Spip.dot" v1.0
' Copyright  2002, Alexis Dupont-Roc distribu sous licence GPL.
'
' Cette macro est compose de plusieurs sous-macros. "versSpip" tant la macro principale
' appelant les autres une  une, dans un ordre bien dfini.
'




' Gnre un texte copiable dans le formulaire de SPIP
Sub versSpip()
    
    Dim nbr_img As Integer
    Dim str_img As String
    
    Selection.WholeStory
    Selection.Copy
    Documents.Add
    Selection.Paste
    
    style_test
    spip_titre1
    spip_titre2
    spip_titre3
    spip_italgras
    spip_italique
    spip_gras
    'spip_guil
    spip_tableau
    spip_normal
    spip_liste
    spip_note
    spip_code
    spip_html
    spip_lien
    
    'traitement des images
    nbr_img = spip_image
    If nbr_img = 1 Then
        str_img = " N'oubliez pas de transfrer votre image lors de la cration de l'article."
    ElseIf nbr_img > 1 Then
        str_img = " N'oubliez pas de transfrer vos " & nbr_img & " images lors de la cration de l'article."
    Else
        str_img = ""
    End If

    Selection.WholeStory
    Selection.style = wdStylePlainText
    
    ActiveDocument.ShowSpellingErrors = False
    ActiveDocument.ShowGrammaticalErrors = False
    ActiveWindow.View.ShowAll = False
          
       
    Selection.Copy
    Selection.InsertBefore "Le texte transform a t copi dans le presse-papier : " & _
        "il ne vous reste plus " & _
        "qu' le coller (Ctrl-V) dans SPIP." & str_img & " Bonne chance !" & Chr(13) & Chr(13)
    
    
    ActiveDocument.Paragraphs(1).style = wdStyleHeading2
        
        
End Sub
'transforme les caractres italiques en : {texte}
Sub spip_italique()
     
     Selection.Find.ClearFormatting
     Selection.Find.Font.Italic = True
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = ""
         .Replacement.Text = "{^&}"
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll

End Sub

'transforme les caractres gras en : {{texte}}
Sub spip_gras()

     Selection.Find.ClearFormatting
     Selection.Find.Font.Bold = True
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = ""
         .Replacement.Text = "{{^&}}"
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll

End Sub

'transforme les caractres italiques+gras en : {{ {texte} }}
Sub spip_italgras()
     
     Selection.Find.ClearFormatting
     Selection.Find.Font.Italic = True
     Selection.Find.Font.Bold = True
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = ""
         .Replacement.Text = "{{ {^&} }}"
         .Replacement.Font.Italic = False
         .Replacement.Font.Bold = False
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll

End Sub

'transforme les guillemets en code html
Sub spip_guil()

 ' 
     Selection.Find.ClearFormatting
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = ""
         .Replacement.Text = "&#171;"
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll

 ' 
     Selection.Find.ClearFormatting
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = ""
         .Replacement.Text = "&#187;"
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll
     
End Sub

' Detection du texte qui n'est pas dans un style spipien
Sub style_test()

Dim i As Integer

For i = 1 To ActiveDocument.Paragraphs.Count
    If mauvaisStyle(ActiveDocument.Paragraphs(i)) Then
        'convertion des styles inconnus au style normal
        ActiveDocument.Paragraphs(i).Range.Select
        'MsgBox "Le texte suivant utilise le style " & Chr(34) & ActiveDocument.Paragraphs(i).style & Chr(34) & " qui n'est pas reconnu par spip. Il ne sera donc pas mis en forme lors de la conversion." & Chr(13) & Chr(13) & Chr(171) & ActiveDocument.Paragraphs(i).Range & Chr(187)
        ActiveDocument.Paragraphs(i).style = wdStyleNormal
    End If
Next i
End Sub

' Teste si le text n'est pas dans un style spipen
Public Function mauvaisStyle(ByVal para As Paragraph) As Boolean
   
Dim test As Boolean

If para.style = ActiveDocument.Styles(wdStyleNormal) Then
    test = False
ElseIf para.style = ActiveDocument.Styles(wdStyleHeading1) Then
    test = False
ElseIf para.style = ActiveDocument.Styles(wdStyleHeading2) Then
    test = False
ElseIf para.style = ActiveDocument.Styles(wdStyleHeading3) Then
    test = False
ElseIf para.style = ActiveDocument.Styles(wdStyleList) Then
    test = False
ElseIf para.style = "Code" Then
    test = False
ElseIf para.style = "Lien en code SPIP" Then
    test = False
ElseIf para.style = "Html" Then
    test = False
ElseIf para.style = ActiveDocument.Styles(wdStyleHyperlink) Then
    test = False
Else
    test = True
End If

mauvaisStyle = test

End Function

' Remplace, dans du texte ayant comme style "Normal", un passage  la ligne par : <br />
Sub spip_normal()
    
    Dim i As Integer
    Dim aRange As Range
  
    For i = 1 To (ActiveDocument.Paragraphs.Count - 1)
    
        'si deux paragraphes consecutifs sont en style "Normal"
        If ActiveDocument.Paragraphs(i).style = ActiveDocument.Styles(wdStyleNormal) Then
            If ActiveDocument.Paragraphs(i + 1).style = ActiveDocument.Styles(wdStyleNormal) Then
        
                'et qu'ils ne sont pas vides (diffrents d'un saut de ligne)
                If ActiveDocument.Paragraphs(i).Range.Characters.Count > 1 Then
                    If ActiveDocument.Paragraphs(i + 1).Range.Characters.Count > 1 Then

                        Set aRange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(i).Range.Start, End:=ActiveDocument.Paragraphs(i).Range.End - 1)
                        aRange.InsertAfter ("<br />")

                    End If
                End If
            End If
        End If
    Next i
    
End Sub

' Convertion du style "Titre 1" en : {{{texte}}}
Sub spip_titre1()

Dim i As Integer
Dim aRange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
    If ActiveDocument.Paragraphs(i).style = ActiveDocument.Styles(wdStyleHeading1) Then
        ActiveDocument.Paragraphs(i).style = wdStyleNormal
        Set aRange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(i).Range.Start, End:=ActiveDocument.Paragraphs(i).Range.End - 1)
        aRange.InsertBefore ("{{{")
        aRange.InsertAfter ("}}}")
    End If
Next i

End Sub

' Convertion du style "Titre 2" en : {{texte}}<br />
Sub spip_titre2()

Dim i As Integer
Dim aRange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
    If ActiveDocument.Paragraphs(i).style = ActiveDocument.Styles(wdStyleHeading2) Then
        ActiveDocument.Paragraphs(i).style = wdStyleNormal
        Set aRange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(i).Range.Start, End:=ActiveDocument.Paragraphs(i).Range.End - 1)
        aRange.InsertBefore ("{{")
        aRange.InsertAfter ("}}<br />")
    End If
Next i

End Sub

' Convertion du style "Titre 3" en : {texte}<br />
Sub spip_titre3()

Dim i As Integer
Dim aRange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
    If ActiveDocument.Paragraphs(i).style = ActiveDocument.Styles(wdStyleHeading3) Then
        ActiveDocument.Paragraphs(i).style = wdStyleNormal
        Set aRange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(i).Range.Start, End:=ActiveDocument.Paragraphs(i).Range.End - 1)
        aRange.InsertBefore ("{")
        aRange.InsertAfter ("}<br />")
    End If
Next i

End Sub

' Convertion du style "Liste" en : - texte
' (Remplacement des fleches par des caractres moins)
Sub spip_liste()

Dim i As Integer
For i = 1 To ActiveDocument.Paragraphs.Count
    If ActiveDocument.Paragraphs(i).style = ActiveDocument.Styles(wdStyleList) Then
        ActiveDocument.Paragraphs(i).style = wdStyleNormal
        ActiveDocument.Paragraphs(i).Range.InsertBefore ("- ")
    End If
Next i

End Sub

' Convertion du style "Code" en : <code>texte</code>
' Cette convertion se base sur la couleur du style (car word n'accepte pas deux styles diffrents dans un mme paragraphe)
' La couleur du style "Code" est : wdGray50 (code 15)
Sub spip_code()

     Selection.Find.ClearFormatting
     Selection.Find.Font.ColorIndex = wdGray50
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = ""
         .Replacement.Text = "<code>^&</code>"
         .Replacement.style = wdStyleNormal
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll

End Sub

' Convertion des objets Footnotes et Endnotes en : [[texte]]
Sub spip_note()

If Selection.Endnotes.Count > 0 Then Selection.Endnotes.Convert

Dim fnote As Footnote
For Each fnote In ActiveDocument.Footnotes
    fnote.Reference.InsertAfter ("[[" & fnote.Range.Text & "]]")
    fnote.Delete
Next fnote

End Sub

' Convertion des tableaux Word en format SPIP
' remarques : - des espaces sont rajouts en fin de cellule pour contourner le problme des cases vides

Sub spip_tableau()

Dim tableau As Table
Dim aRange As Range

For Each tableau In ActiveDocument.Tables

    Dim i As Integer
    Dim j As Integer
    For i = 1 To tableau.Rows.Count
        For j = 1 To tableau.Columns.Count
            
            Selection.Find.ClearFormatting
            tableau.Cell(i, j).Select
            Selection.Find.Replacement.ClearFormatting
            With Selection.Find
                .Text = "|"
                .Replacement.Text = "<html>|</html>"
                .Forward = True
                .Wrap = wdFindStop
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
            
            tableau.Cell(i, j).Range.InsertBefore "|"
        Next j
        tableau.Cell(i, tableau.Columns.Count).Range.InsertAfter " |"
    Next i

    Set aRange = tableau.ConvertToText(Separator:=" ")
    aRange.style = wdStylePlainText
    
    'teste si une ligne a bien t laisse avant et aprs le tableau
    If ActiveDocument.Characters(aRange.Start - 2) <> Chr(13) Then
        aRange.InsertBefore Chr(13)
    End If
    If ActiveDocument.Characters(aRange.End + 1) <> Chr(13) Then
        aRange.InsertAfter Chr(13)
    End If
    
Next tableau

End Sub

' Convertion des liens hypertexte en : [nom_du_lien->adresse_du_lien]
' Remarque : les liens peuvent toujours tre entrs manuellement avec le style "Lien en code SPIP"
Sub spip_lien()

Dim i As Integer
Dim aLink As Hyperlink
Dim url As String
For i = 1 To ActiveDocument.Hyperlinks.Count
    Set aLink = ActiveDocument.Hyperlinks(i)
    url = aLink.Address
    aLink.Range.style = wdStyleNormal
    aLink.Range.InsertBefore ("[")
    aLink.Range.InsertAfter ("->" & url & "]")
Next i

End Sub

' Cette macro devait avoir une interface pour les images je n'ai pas eu le temps de la faire
Function spip_image() As Integer

Dim aInshape As InlineShape
Dim aShape As Shape
Dim i As Integer

For Each aShape In ActiveDocument.Shapes
    aShape.ConvertToInlineShape
Next aShape

'If ActiveDocument.InlineShapes.Count > 0 Then
'    MsgBox "Attention : cette macro ne traite pas les objets image (Shapes)." & _
'        Chr(13) & Chr(13) & _
'        "Utilisez l'outil ""Tlcharger une nouvelle image"" de SPIP, puis " & _
'        "modifiez le code correspondant (<IMG1|left>, <IMG1|center> " & _
'        "ou <IMG1|right>) dans votre document. ", vbCritical
'End If

i = 0
For Each aInshape In ActiveDocument.InlineShapes
    i = i + 1
    aInshape.Select
    Selection.InsertAfter Chr(13) & "<IMG" & i & "|left>" & Chr(13)
    Selection.Font.ColorIndex = wdRed
    aInshape.Delete
Next aInshape

spip_image = i

End Function

' Convertion du style "Html" en : <html>texte</html>
' Cette convertion se base sur la couleur du style (car word n'accepte pas deux styles diffrents dans un mme paragraphe)
' La couleur du style "Html" est : wdTeal (code 10)
Sub spip_html()

     Selection.Find.ClearFormatting
     Selection.Find.Font.ColorIndex = wdTeal
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = ""
         .Replacement.Text = "<html>^&</html>"
         .Replacement.style = wdStyleNormal
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll

End Sub

