Convertir un quizz

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.

Partagez: