Petite macro word pour convertir un fichier dont les bonnes réponses sont en rouge. Le résultat devrait pouvoir s’importer facilement dans Moodle.
Il est préférable de transformer le fichier original Word en rtf, car de certaines cases à coché sont converties en espace de formulaire dans les nouvelles versions, ce qui empèche la recherche.
Sub check()
'sert à vérifier le nb de paragraphes
MsgBox (ActiveDocument.Paragraphs.Count)
End Sub
Sub charcode()
'permet d'afficher le code du premier caractère de la sélection
'Très utile pour avoir le code d'une case à cocher par ex
'MsgBox (Asc(Left(Application.Selection.Text, 1)))
MsgBox (Asc(Left(ActiveDocument.Paragraphs(1188).Range.Text, 1)))
End Sub
Sub paragraphIndex()
'en cas d'arrêt sur une ligne, permet de connaître le numéro du
' paragraphe en le sélectionnant
MsgBox ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
End Sub
Sub Conversion()
'
' On rajoute des paragraphes, le nb de paragraphes est à modifier
' dans la boucle, sinon s'arrête avant la fin
'
'
'On Error Resume Next
Dim counterA, counterL As Integer
Dim letter(3) As String
Dim answers As Boolean
Dim firstchar As String
Dim charcode As Integer
Dim solutionColorIndex As Integer
Dim solutionLetter As String
Dim l As Integer
l = 0
solutionColorIndex = 6 ' red font => 6, black => 1
'letter = Array("A", "B", "C", "D")
letter(0) = "A"
letter(1) = "B"
letter(2) = "C"
letter(3) = "D"
counterA = 0
counterL = 0
answers = False
For i = 1 To ActiveDocument.Paragraphs.Count + 40
Line = ActiveDocument.Paragraphs(i).Range.Text
'MsgBox (Line & " " & ActiveDocument.Paragraphs(i).Range.Font.ColorIndex)
'demander le code du premier caractère sur une ligne
'vide génère une erreur
If Len(Line) > 0 Then
firstchar = Left(Line, 1)
charcode = Asc(firstchar)
End If
's'il y a une case à cocher
If (charcode = 63) Then
'si on n'était pas dans une réponse, on démarre
'la liste des lettres
If (answers = False) Then
answers = True
counterA = counterA + 1
End If
If ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = solutionColorIndex Then
solutionLetter = letter(counterL)
End If
ActiveDocument.Paragraphs(i).Range.Text = letter(counterL) & Line
counterL = counterL + 1
Else
If (answers = True) Then
ActiveDocument.Paragraphs(i).Range.InsertBefore "ANSWER: " & solutionLetter & vbCrLf
answers = False
counterL = 0
End If
End If
l = l + 1
Next
MsgBox (l & " over")
End Sub
Pour l’instant, la conversion s’arrête sur une erreur, car le nombre de paragraphe demandé dépasse le nombre de paragraphe réel.