1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
| Private Sub BCImprimer_Click()
On Error GoTo 1
'/////*************************************
If CbClasse = "" Then
MsgBox ("Entrez la Classe SVP!")
Else
If CbMatiere = "" Then
MsgBox ("Entrez la Matière concernée")
End If
End If
Dim a As New Application
Dim Lig As Integer
a.Visible = True
Dim MyBook As Workbook
Set MyBook = a.Workbooks.Open(App.Path & "\Etat Fiche.xls")
Lig = 21
Dim Db As Database
Dim Rs As Recordset
Dim Rs2 As Recordset
Dim SQL, Sql2 As String
Set Db = OpenDatabase(App.Path & "\bdgesfip.mdb") ', False, False, ";pwd=796093302730")
SQL = "SELECT deroulement.ETAPES, deroulement.ACTMAITRE, " _
& "deroulement.ACTELEVE, deroulement.OBSERVATION " _
& "From deroulement " _
& "WHERE (((deroulement.MATIERE)='" & CbMatiere & "') AND ((deroulement.SEMAINE)='" & CbSemaine & "') AND " _
& "((deroulement.CLASSE)='" & CbClasse & "'));"
Set Rs = Db.OpenRecordset(SQL)
'If Rs.RecordCount > 0 Then
a.ActiveWorkbook.Worksheets("Fiche2").Activate
'With a.ActiveWorkbook.Worksheets("Versements").Activate
With MyBook.Worksheets("Fiche2")
.Range("B4").Value = TxtDiscipline.Text
.Range("B5").Value = TxtTheme.Text
.Range("B6").Value = TxtLecon.Text
.Range("B7").Value = TxtSeance.Text
.Range("B8").Value = TxtMateriel.Text
.Range("F4").Value = TxtNiveau.Text
.Range("F5").Value = TxtDuree.Text
.Range("F6").Value = TxtSemaine.Text
.Range("F7").Value = TxtNumfich.Text
.Range("A12").Value = TxtObjectif.Text
.Range("D12").Value = TxtObjectif1.Text
.Range("E12").Value = TxtObjectif2.Text
'.Font.Bold = True
If Rs.RecordCount = 0 Then GoTo Fin
Rs.MoveFirst
Do Until Rs.EOF
.Cells(Lig, 1).Borders.LineStyle = xlContinuous
.Cells(Lig, 2).Borders.LineStyle = xlContinuous
.Cells(Lig, 3).Borders.LineStyle = xlContinuous
.Cells(Lig, 4).Borders.LineStyle = xlContinuous
.Cells(Lig, 5).Borders.LineStyle = xlContinuous
.Rows("21:500").AutoFit
.Cells(Lig, 1) = Rs![ETAPES]
.Cells(Lig, 2) = Rs![ACTMAITRE]
.Cells(Lig, 4) = Rs![ACTELEVE]
.Cells(Lig, 5) = Rs![OBSERVATION]
Rs.MoveNext
Lig = Lig + 1
Loop
End With
'End If '
Fin:
a.ActiveWorkbook.Worksheets("Fiche2").PrintPreview
1:
End Sub |
Partager