LAYOUDE.MesTravauxEns

Sub exo3()
'
'
Dim doc As Document
Dim tabl, tab1, tab2   As Table
Dim entete As HeaderFooter
Dim numEnre, dernierEnre, niv, cmpteur, numTab1, numTab2 As Integer
Dim nbparag, c101, c102, c103, c104, c105, c106, ced1, ced2, ctotal As Integer
Dim nom, credit, niveau As String
Dim appXls As Excel.Application
Dim feuille As Excel.Worksheet
Dim docXls As Object
 
 
Set doc = Application.ActiveDocument
 
' marge du document'''''1 pouce= 2,54 cm= 72 points'''
    doc.PageSetup.RightMargin = InchesToPoints(0.9842)
    doc.PageSetup.LeftMargin = InchesToPoints(0.9842)
    doc.PageSetup.TopMargin = InchesToPoints(0.874)
    doc.PageSetup.BottomMargin = InchesToPoints(1.1259)
 
 
With doc.Sections(1)
    .Headers(wdHeaderFooterPrimary).Range.Paragraphs.Add
    .Footers(wdHeaderFooterPrimary).Range.Text = "Procès verbal récapitulatif réalisé par MBIENDA JUDITH"
    .Footers(wdHeaderFooterPrimary).Range.Font.Name = "monotype corsiva"
    .Footers(wdHeaderFooterPrimary).Range.Font.Size = 12
    .Footers(wdHeaderFooterPrimary).Range.Font.Color = wdColorDarkBlue
    .Footers(wdHeaderFooterPrimary).Range.Paragraphs(1).Alignment = wdAlignParagraphCenter
     
     
End With
 
Set tabl = doc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Paragraphs(1).Range.Tables.Add(Range:=doc.Sections(1).Headers(wdHeaderFooterPrimary).Range, NumRows:=1, NumColumns:=3)
 
 With tabl.Cell(1, 1)
    .SetWidth ColumnWidth:=InchesToPoints(3), RulerStyle:=wdAdjustProportional
    .Range.Paragraphs.Add
    .Range.Paragraphs(1).Range.Text = "UNIVERSITE DE YAOUNDE I"
    .Range.Paragraphs(1).Range.Font.Size = 9
    .Range.Paragraphs(1).Alignment = wdAlignParagraphCenter
    .Range.Paragraphs(1).Range.Font.Bold = True
    .Range.Paragraphs(1).Range.Font.Name = "Century Schoolbook"
    .Range.Paragraphs(1).SpaceAfter = 0
    .Range.Paragraphs(1).SpaceBefore = 0
 
    .Range.Paragraphs.Add
    .Range.Paragraphs(2).Range.Font.Bold = False
    .Range.Paragraphs(2).Range.Text = "***"
     
    .Range.Paragraphs.Add
    .Range.Paragraphs(3).Range.Text = "ECOLE NORMALE SUPERIEURE"
     
    .Range.Paragraphs.Add
    .Range.Paragraphs(4).Range.Text = "***"
     
    .Range.Paragraphs.Add
    .Range.Paragraphs(5).Range.Text = "DEPARTEMENT D 'INFORMATIQUE ET DES TECHNOLOGIES EDUCATIVES"
    .Range.Paragraphs(5).Range.Font.Bold = True
     
    .Range.Paragraphs.Add
    .Range.Paragraphs(6).Range.Text = "***"
    .Range.Paragraphs(6).Range.Font.Name = "calibri"
    .Range.Paragraphs(6).Range.Font.Italic = True
     
    .Range.Paragraphs.Add
    .Range.Paragraphs(7).Range.Text = "Le Chef de Département"
    .Range.Paragraphs(7).Range.Font.Size = 10
    .Range.Paragraphs(7).Range.Font.Italic = False
     
    .Range.Paragraphs.Add
    .Range.Paragraphs(8).Range.Text = "***"
    .Range.Paragraphs(8).Range.Font.Italic = True
        
        
End With
                 
        '_______ image de l'entete __________________
     
    With tabl.Cell(1, 2)
            .SetWidth ColumnWidth:=InchesToPoints(1.57), RulerStyle:=wdAdjustProportional
            .Range.InlineShapes.AddPicture FileName:=doc.Path & "\logo.gif"
            .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
 
                End With
    '_________cellule 3 _______________
     
    With tabl.Cell(1, 3)
            .SetWidth ColumnWidth:=InchesToPoints(2.75), RulerStyle:=wdAdjustProportional
            .Range.Paragraphs.Add
            .Range.Paragraphs(1).Range.Text = "REPUBLIQUE DU CAMEROUN"
            .Range.Paragraphs(1).Range.Font.Size = 9
            .Range.Paragraphs(1).Alignment = wdAlignParagraphCenter
            .Range.Paragraphs(1).Range.Font.Bold = True
            .Range.Paragraphs(1).Range.Font.Name = "Century Schoolbook"
            .Range.Paragraphs(1).SpaceAfter = 0
            .Range.Paragraphs(1).SpaceBefore = 0
 
            .Range.Paragraphs.Add
            .Range.Paragraphs(2).Range.Text = "REPUBLIC OF CAMEROON"
            .Range.Paragraphs(2).Range.Font.Italic = True
             
             
            .Range.Paragraphs.Add
            .Range.Paragraphs(3).Range.Text = "***"
            .Range.Paragraphs(3).Range.Font.Italic = False
            .Range.Paragraphs(3).Range.Font.Bold = False
             
            .Range.Paragraphs.Add
            .Range.Paragraphs(4).Range.Text = "Paix -Travail - Patrie"
             
            .Range.Paragraphs.Add
            .Range.Paragraphs(5).Range.Text = "Peace -Work - Fatherland"
            .Range.Paragraphs(5).Range.Font.Italic = True
            .Range.Paragraphs(5).Range.Font.Name = "calibri"
             
            .Range.Paragraphs.Add
            .Range.Paragraphs(6).Range.Text = "***"
            .Range.Paragraphs(6).Range.Font.Italic = False
            .Range.Paragraphs(6).Range.Font.Bold = False
            .Range.Paragraphs(6).Range.Font.Name = "Century Schoolbook"
             
             
      End With
 ''____________fin entete___________________
 
'______________ouverture de l'application______________________________________
 
 Set appXls = CreateObject("excel.application")
 Set docXls = appXls.Workbooks.Open(doc.Path & "\NOTES.xls", UpdateLinks:=True, ReadOnly:=False)
 Set feuille = appXls.ActiveWorkbook.ActiveSheet
 '__________________fin de l'ouverture__________________________________________
 
' ____initialisation du numero du premier enrgistrement____________
numEnre = 10
 
'__________recherche dernier enreg_____________
nom = feuille.Application.Cells(numEnre, 2)
While nom <> ""
     numEnre = numEnre + 1
    nom = feuille.Application.Cells(numEnre, 2)
Wend
dernierEnre = numEnre - 1
numEnre = 10
 
'____entete du premier tableau
doc.Paragraphs.Add
 
' gerer le fait kon doit entrer une valeur entiere
 
Do
    niv = InputBox("Entrer le niveau correspondant", "NIVEAU")
Loop While Not IsNumeric(niv)
 
 
 
 
'intitulé du premier tableau
 
doc.Paragraphs(1).Range.Text = "Liste des étudiants admis au niveau  " & niv
doc.Paragraphs(1).Range.Font.Size = 14
doc.Paragraphs(1).Range.Font.Name = "Times New Roman"
doc.Paragraphs(1).Range.Font.Bold = True
doc.Paragraphs(1).Range.Underline = wdUnderlineSingle
doc.Paragraphs(1).Alignment = wdAlignParagraphCenter
doc.Paragraphs(1).SpaceAfter = 0
doc.Paragraphs(1).SpaceBefore = 0
 
'_____création table et insertion des élément
 
doc.Paragraphs.Add
doc.Paragraphs.Add
 
Set tab1 = doc.Tables.Add(Range:=doc.Paragraphs(3).Range, NumRows:=1, NumColumns:=4)
doc.Range.Tables(1).Borders.Enable = True
' paramètre du tableau: largeur préférée= 16cm et retrait gauche = -1,06cm
 
 
'style de la première ligne du premier tableau
tab1.Rows(1).Range.Font.Bold = True
tab1.Rows(1).Range.Font.Size = 10
tab1.Rows(1).Range.Font.Underline = False
 
tab1.Cell(1, 1).Range.Text = "N°"
tab1.Cell(1, 1).SetWidth ColumnWidth:=InchesToPoints(0.7874), RulerStyle:=wdAdjustNone
 
tab1.Cell(1, 2).Range.Text = "NOMS ET PRENOMS"
tab1.Cell(1, 2).SetWidth ColumnWidth:=InchesToPoints(2.1496), RulerStyle:=wdAdjustNone
 
tab1.Cell(1, 3).Range.Text = "MATRICULE"
tab1.Cell(1, 3).SetWidth ColumnWidth:=InchesToPoints(1.3779), RulerStyle:=wdAdjustNone
 
tab1.Cell(1, 4).Range.Text = "DETTE N" & (niv - 1)
tab1.Cell(1, 4).SetWidth ColumnWidth:=InchesToPoints(2.5748), RulerStyle:=wdAdjustNone
 
doc.Paragraphs.Add
doc.Paragraphs.Add
nbparag = doc.Paragraphs.Count
doc.Paragraphs(nbparag).Range.Text = "Liste des étudiants admis à redoubler le niveau  " & (niv - 1)
 
doc.Paragraphs.Add
doc.Paragraphs.Add
Set tab2 = doc.Tables.Add(Range:=doc.Paragraphs(nbparag + 2).Range, NumRows:=1, NumColumns:=4)
doc.Range.Tables(2).Borders.Enable = True
' paramètre du tableau: largeur préférée= 16cm et retrait gauche = -1,06cm
 
doc.Tables(1).Rows.LeftIndent = InchesToPoints(-0.5)
 
'style de la première ligne du deuxième tableau
tab2.Rows(1).Range.Font.Bold = True
tab2.Rows(1).Range.Font.Size = 10
tab2.Rows(1).Range.Font.Underline = False
tab2.Cell(1, 1).Range.Text = "N°"
tab2.Cell(1, 1).SetWidth ColumnWidth:=InchesToPoints(0.7874), RulerStyle:=wdAdjustNone
 
tab2.Cell(1, 2).Range.Text = "NOMS ET PRENOMS"
tab2.Cell(1, 2).SetWidth ColumnWidth:=InchesToPoints(2.1496), RulerStyle:=wdAdjustNone
 
tab2.Cell(1, 3).Range.Text = "MATRICULE"
tab2.Cell(1, 3).SetWidth ColumnWidth:=InchesToPoints(1.3779), RulerStyle:=wdAdjustNone
 
tab2.Cell(1, 4).Range.Text = "DETTE N" & (niv - 1)
 
tab2.Cell(1, 4).SetWidth ColumnWidth:=InchesToPoints(2.5748), RulerStyle:=wdAdjustNone
 
doc.Tables(1).Rows.LeftIndent = InchesToPoints(-0.5)
 
'____________________traitement des données________________
cmpteur = numEnre
numTab1 = 1
numTab2 = 1
 
While cmpteur <> (dernierEnre + 1)
    credit = ""
    ctotal = feuille.Application.Cells(cmpteur, 20)
    If ctotal > 44 Then 'eleve admis
        tab1.Rows.Add
        tab1.Cell(numTab1 + 1, 1) = numTab1
        tab1.Cell(numTab1 + 1, 2) = feuille.Application.Cells(cmpteur, 3)
        tab1.Cell(numTab1 + 1, 3) = feuille.Application.Cells(cmpteur, 2)
             
            If feuille.Application.Cells(cmpteur, 5) = 0 Then
                credit = credit & "INFO 101 "
            End If
             
            If feuille.Application.Cells(cmpteur, 7) = 0 Then
                credit = credit & "INFO 102 "
            End If
             
            If feuille.Application.Cells(cmpteur, 9) = 0 Then
                credit = credit & "INFO 103 "
            End If
             
            If feuille.Application.Cells(cmpteur, 11) = 0 Then
                credit = credit & "INFO 104 "
            End If
             
            If feuille.Application.Cells(cmpteur, 13) = 0 Then
                credit = credit & "INFO 105 "
            End If
             
            If feuille.Application.Cells(cmpteur, 15) = 0 Then
                credit = credit & "INFO 106 "
            End If
             
            If feuille.Application.Cells(cmpteur, 17) = 0 Then
                credit = credit & "SCEDI 101 "
            End If
             
            If feuille.Application.Cells(cmpteur, 19) = 0 Then
                credit = credit & "SCEDI 102 "
            End If
             
        tab1.Cell(numTab1 + 1, 4) = (60 - ctotal) & ":" & credit
        numTab1 = numTab1 + 1
      
     
    Else ' eleve non admis
        tab2.Rows.Add
        tab2.Cell(numTab2 + 1, 1).Range.Text = numTab2
        tab2.Cell(numTab2 + 1, 2).Range.Text = feuille.Application.Cells(cmpteur, 3)
        tab2.Cell(numTab2 + 1, 3).Range.Text = feuille.Application.Cells(cmpteur, 2)
        If feuille.Application.Cells(cmpteur, 5) = 0 Then
                credit = credit & "INFO 101 "
        End If
 
        If feuille.Application.Cells(cmpteur, 7) = 0 Then
                credit = credit & "INFO 102 "
        End If
 
        If feuille.Application.Cells(cmpteur, 9) = 0 Then
                credit = credit & "INFO 103 "
        End If
 
        If feuille.Application.Cells(cmpteur, 11) = 0 Then
                credit = credit & "INFO 104 "
        End If
 
        If feuille.Application.Cells(cmpteur, 13) = 0 Then
                credit = credit & "INFO 105 "
        End If
 
        If feuille.Application.Cells(cmpteur, 15) = 0 Then
                credit = credit & "INFO 106 "
        End If
 
        If feuille.Application.Cells(cmpteur, 17) = 0 Then
                credit = credit & "SCEDI 101 "
        End If
 
        If feuille.Application.Cells(cmpteur, 19) = 0 Then
                credit = credit & "SCEDI 102 "
        End If
 
        tab2.Cell(numTab1 + 1, 4).Range.Text = (60 - ctotal) & ":" & credit
        numTab2 = numTab2 + 1
    End If
     
    cmpteur = cmpteur + 1
     
Wend
             
    '__________fermeture de lapplication exel_____________
    appXls.Workbooks.Close
 
 
End Sub