Citation :
Sub creationLignes()
Selection.MoveUp unit:=wdScreen, Count:=2
Selection.MoveDown unit:=wdLine, Count:=13
Selection.MoveDown unit:=wdLine, Count:=100, Extend:=wdExtend
Selection.Delete unit:=wdCharacter, Count:=1
On Error GoTo GestionErreur
Dim FichierWord As Variant
'Document à ouvrir
Dim chemin As String
chemin = ThisDocument.Path & "\..\ConstitutionGroupesEtAffectationSujets.doc"
'Création de l'objet Word
Set FichierWord = CreateObject("word.application" )
FichierWord.Documents.Open FileName:=chemin, ReadOnly:=False
Dim j As Integer
For i = 1 To 30
j = 1
Do While (j <= 5)
'boucle vérifiant si il y a au moins un étudiant pour le groupe i
If (FichierWord.ActiveDocument.FormFields("Etu" & j & "_" & i).Result <> "" ) Then
j = 6
'vérifier que le champs option est remplie
If (FichierWord.ActiveDocument.FormFields("Option_" & i).Result <> "" ) Then
'vérifier que le champs contient ISI ou IGI
If UCase(FichierWord.ActiveDocument.FormFields("Option_" & i).Result) = "IGI" Or UCase(FichierWord.ActiveDocument.FormFields("Option_" & i).Result) = "ISI" Then
Selection.TypeText Text:=("Groupe " & i)
If i < 10 Then
Selection.TypeText Text:=(" " )
Else
Selection.TypeText Text:=(" " )
End If
Selection.FormFields.Add Range:=Selection.Range, Type:= _
wdFieldFormTextInput
Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
With Selection.FormFields(1)
.Name = ("RespGestProjTD" & i)
.EntryMacro = ""
.ExitMacro = ""
.Enabled = True
.OwnHelp = False
.HelpText = ""
.OwnStatus = False
.StatusText = ""
With .TextInput
.EditType Type:=wdRegularText, Default:="", Format:=""
.Width = 0
End With
End With
Selection.MoveRight unit:=wdCharacter, Count:=10
Selection.TypeParagraph
Selection.TypeParagraph
'si champs contient une mauvaise information (string autre que ISI ou IGI)
Else
'charge la fenêtre qui avertie de l'erreur et propose une correction
Load Erreur
Erreur.CmbOption.AddItem "IGI"
Erreur.CmbOption.AddItem "ISI"
Erreur.Show
vOption = Erreur.CmbOption.Value
MsgBox (vOption)
Selection.TypeText Text:=("Groupe " & i)
If i < 10 Then
Selection.TypeText Text:=(" " )
Else
Selection.TypeText Text:=(" " )
End If
Selection.FormFields.Add Range:=Selection.Range, Type:= _
wdFieldFormTextInput
Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
With Selection.FormFields(1)
.Name = ("RespGestProjTD" & i)
.EntryMacro = ""
.ExitMacro = ""
.Enabled = True
.OwnHelp = False
.HelpText = ""
.OwnStatus = False
.StatusText = ""
With .TextInput
.EditType Type:=wdRegularText, Default:="", Format:=""
.Width = 0
End With
End With
Selection.MoveRight unit:=wdCharacter, Count:=10
Selection.TypeParagraph
Selection.TypeParagraph
'modifier le fichier "constitution groupe"
FichierWord.ActiveDocument.FormFields("Option_" & i).Result = vOption
End If 'fin de vérif ISI et IGI
Else
'charge la fenêtre qui avertie de l'erreur et propose une correction
Load Erreur
Erreur.CmbOption.AddItem "IGI"
Erreur.CmbOption.AddItem "ISI"
Erreur.Show
a = Erreur.CmbOption.Text
MsgBox (a)
Selection.TypeText Text:=("Groupe " & i)
If i < 10 Then
Selection.TypeText Text:=(" " )
Else
Selection.TypeText Text:=(" " )
End If
Selection.FormFields.Add Range:=Selection.Range, Type:= _
wdFieldFormTextInput
Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
With Selection.FormFields(1)
.Name = ("RespGestProjTD" & i)
.EntryMacro = ""
.ExitMacro = ""
.Enabled = True
.OwnHelp = False
.HelpText = ""
.OwnStatus = False
.StatusText = ""
With .TextInput
.EditType Type:=wdRegularText, Default:="", Format:=""
.Width = 0
End With
End With
Selection.MoveRight unit:=wdCharacter, Count:=10
Selection.TypeParagraph
Selection.TypeParagraph
'modifier le fichier "constitution groupe"
FichierWord.ActiveDocument.FormFields("Option_" & i).Result = vOption
End If 'fin option remplie
Else
j = j + 1
End If 'fin boucle
Loop
Next
GoTo fin
GestionErreur:
fin:
'Fermeture du document
'ActiveDocument.Protect Password:="", Noreset:=True, Type:=wdAllowOnlyFormFields
ThisDocument.Save
FichierWord.Quit
End Sub
|
