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 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
|
Sub RemplirListeClasseurs()
On Error Resume Next
Dim App As Excel.Application
Dim Classeur As Excel.Worksheet
Dim strFichier As String 'Nom du fichier Excel
Dim I As Integer
Dim Nb As Integer
strFichier = Me.sCheminFichier
Set App = CreateObject("Excel.application") 'Ouverture d'Excel
App.Workbooks.Open strFichier 'Ouverture du fichier à traiter
With App
'Vidage de la liste
Do While Me.ListeClasseurs.ListCount > 0
DoEvents
'Nb = Me.ListeClasseurs.ListCount
'For i = 0 To Me.ListeClasseurs.ListCount - 1
Me.ListeClasseurs.RemoveItem 0
Me.ListeClasseurs.Requery
'Next i
Loop
'Remplissage de la liste
For Each Classeur In .Worksheets
DoEvents
Me.ListeClasseurs.AddItem Classeur.Name
Next
End With
' ferme excel
App.Workbooks.Close
App.Quit
Set App = Nothing
Set Classeur = Nothing
End Sub
Sub CreerTableEtImporterDonnees()
'On Error Resume Next
Dim dbs As DAO.Database
Dim strNomTable As String
Dim strSQL As String
Dim rst As DAO.Recordset
Dim I As Integer
Dim strChamp As String
Dim Fichier As String
Dim Feuille As String
Dim N As Integer
Dim strMsg As String
strSQL = "SELECT * FROM MATIERE_CLASSE_FR WHERE annee_scol='" & Me.txtANNEE & "' AND classe_francais ='" & Me.txtCLASSE & "' AND NumCompoMCFr =" & Me.txtCOMPO & " AND Identif_EtablisFR =" & Me.Txt_EtablissementFr & ";"
'strNomTable = "Temp_" & Left(Me.txtCOMPO, 1) & Right(Me.txtCOMPO, 11) & "_" & Right(Me.txtANNEE, 4)
strNomTable = "Temp_Importation_NotesExcel_Fr"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL)
If TableExiste(strNomTable) Then
SupprimerTable (strNomTable)
'MsgBox "Elle existe"
End If
'On Error Resume Next
strSQL = "CREATE TABLE [" & strNomTable & "] (ID_Etab INTEGER ,anscol CHAR, CompoFRANCAIS INTEGER, ClasseFr CHAR, mle_Eleve INTEGER, NomEleve CHAR);"
strSQL = "CREATE TABLE [" & strNomTable & "] (Appreciation CHAR, Classement CHAR, MOYENNE REAL, TOTAL REAL);"
DoCmd.SetWarnings False
dbs.Execute strSQL
If Not rst.EOF Then '
rst.MoveLast
Do While Not rst.BOF
' strChamp = fSENS_parID_Matiere_AR(rst.Fields("matiere_arabe"))
'On Error Resume Next
strSQL = "ALTER TABLE " & strNomTable & " ADD COLUMN [" & strChamp & "] REAL;"
DoEvents
dbs.Execute strSQL
rst.MovePrevious
Loop
End If
'On Error Resume Next
strSQL = "ALTER TABLE " & strNomTable & " ADD COLUMN NomEleve CHAR;"
DoEvents
dbs.Execute strSQL
strSQL = "ALTER TABLE " & strNomTable & " ADD COLUMN mle_Eleve INTEGER;"
DoEvents
dbs.Execute strSQL
strSQL = "ALTER TABLE " & strNomTable & " ADD COLUMN ClasseFr CHAR;"
DoEvents
dbs.Execute strSQL
strSQL = "ALTER TABLE " & strNomTable & " ADD COLUMN anscol CHAR;"
DoEvents
dbs.Execute strSQL
strSQL = "ALTER TABLE " & strNomTable & " ADD COLUMN CompoFRANCAIS INTEGER;"
DoEvents
dbs.Execute strSQL
strSQL = "ALTER TABLE " & strNomTable & " ADD COLUMN ID_Etab INTEGER;"
DoEvents
dbs.Execute strSQL
Fichier = Me.sCheminFichier
Feuille = Me.ListeClasseurs & "!"
DoCmd.RunSQL "DELETE * FROM " & strNomTable & ";"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, strNomTable, Fichier, True, Feuille
DoCmd.SetWarnings True
rst.Close
Set rst = Nothing
End Sub
Private Sub btn_Traitement_Click()
DelierTableExcel '--- surtout utile pendant mise au point !
LierTableExcel '--- Lier à la feuille Excel sélectionnée
InserrerNotes Me.Txt_EtablissementFr, Me.txtANNEE, Me.txtCLASSE, Me.txtCOMPO
DelierTableExcel
End Sub
Sub InserrerNotes(vEcole As Long, vAnScol As String, vClas As String, vCompo As String)
On Error Resume Next
Dim dbs As DAO.Database
Dim strSQL As String
Dim strSQL_Eleve As String
Dim rst As DAO.Recordset
Dim rstEleve As DAO.Recordset
Dim I As Integer
Dim strNomTable As String
'Variables de l'entête de la compo
Dim stAnnee As String
Dim vMle_El As Long
Dim vClasse As String
Dim vNatCompo As String
Dim vStatut As String
Dim vID_Etab As Long
Dim N As Integer
Dim sCoef As Integer
Dim idAuto As Long
Dim idComp As Long
Dim NumMat As Long
Dim LaNote As Single
DoCmd.SetWarnings True
strSQL_Eleve = "SELECT * FROM Req_Eleve_INSCRIT WHERE ID_ETABL_FREQ=" & vEcole & " AND ANNEE_SCOL ='" & vAnScol & "' AND ClasseFrancais ='" & vClas & "'; "
strNomTable = "Temp_Importation_NotesExcel_Fr"
Set dbs = CurrentDb
Set rstEleve = dbs.OpenRecordset(strSQL_Eleve)
Debug.Print "rstEleve.RecordCount: "; rstEleve.RecordCount
If Not rstEleve.EOF Then 'On boucle sur la liste des élèves de la classe
rstEleve.MoveFirst
Do While Not rstEleve.EOF
DoEvents
Debug.Print "------------- élève suivant ---------------"
Me.lblMessage.Caption = "Traitement de l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
Me.lblMessage.Visible = True
strSQL = "SELECT * FROM " & strNomTable & " WHERE mle_Eleve =" & rstEleve.Fields("Mleeleve") & " AND anscol='" & vAnScol & "' AND CompoFRANCAIS =" & vCompo & " AND ID_Etab =" & vEcole & ";"
Debug.Print strSQL
Set rst = dbs.OpenRecordset(strSQL)
If rst Is Nothing Then
MsgBox "rst is Nothing !", vbCritical, "rst vide"
Exit Sub
End If
Debug.Print "Mleeleve: "; rstEleve.Fields("Mleeleve"),
Debug.Print "rst.RecordCount: ";
Debug.Print rst.RecordCount
If Not rst.EOF Then
N = 3
rst.MoveFirst
Do While Not rst.EOF
DoEvents
'Initialisation de l'entête de des notes [INFOS_COMPOSITION_FRANCAIS] pour l'élève actif
idComp = NumeroAutoCompoFrancais() + 1
stAnnee = vAnScol
vMle_El = rstEleve.Fields("Mleeleve")
vClasse = vClas
vNatCompo = vCompo
vStatut = "Classé"
vID_Etab = vEcole
If CompoDejaImportée_Fr(Me.txtANNEE, rstEleve("Mleeleve"), Me.txtCLASSE, Me.txtCOMPO, Me.Txt_EtablissementFr) = False Then
strSQL = "INSERT INTO INFOS_COMPOSITION_FRANCAIS (idCompoF, anscol, mle_Eleve, ClasseFr, CompoFRANCAIS, Statut, ID_Etab) VALUES (" & idComp & ", '" & stAnnee & "', " & vMle_El & ", '" & vClasse & "', " & vNatCompo & ", '" & vStatut & "', " & vID_Etab & " );"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
idAuto = NumeroAutoNotesFrancais()
DoEvents
For I = 1 To Me.NbreMatiere
Debug.Print "i: "; I,
DoEvents
idAuto = idAuto + 1
' NumMat = CLng(fIDM_parSENS_MATIERE_AR(rst.Fields(N + I).Name))
Debug.Print "N+I: "; N + I,
' Debug.Print "NumMat: "; NumMat,
' Debug.Print "Name: "; rst.Fields(N + I).Name
' 'Teste le contenu des cellules de notes
' If IsNull(rst.Fields(N + I).Value) Then
'LaNote = 0
' Else
'LaNote = CSng(rst.Fields(N + I).Value)
' End If
For I = 1 To Me.NbreMatiere
DoEvents
idAuto = idAuto + 1
NumMat = CLng(fIDM_parMATIERE(rst.Fields(N + I).Name))
'Teste le contenu des cellules de notes
If IsNull(rst.Fields(N + I).Value) Then
LaNote = 0
Else
LaNote = CSng(rst.Fields(N + I).Value)
End If
sCoef = fCOEF_parMATIERE(Me.txtANNEE, Me.txtCLASSE, fIDM_parMATIERE(rst.Fields(N + I).Name), Me.txtCOMPO, Me.Txt_EtablissementFr)
strSQL = "INSERT INTO NOTES_CLASSES_FRANCAIS (idNotesArabe, idCF, matiereFr, coef, Ident_Etabl_FR) VALUES (" & idAuto & ", " & idComp & ", " & NumMat & ", " & sCoef & ", " & vID_Etab & ");"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
strSQL = "update NOTES_CLASSES_FRANCAIS set NOTES_CLASSES_FRANCAIS.Note =" & Replace(LaNote, ",", ".") & _
" NOTES_CLASSES_FRANCAIS.idNotesFrancais =" & idAuto & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
strSQL = ""
Next I
Else
Me.lblMessage.Caption = "Notes déjà importées pour l'élève n°" & rstEleve.Fields("Mleeleve") & "-" & rstEleve.Fields("nom") & " " & rstEleve.Fields("prenom")
Me.lblMessage.Visible = True
End If
rst.MoveNext
Loop
End If
rstEleve.MoveNext
Loop
MsgBox "Transfert effectué avec succès !"
DoCmd.OpenForm " NOTES DE COMPOSITIONS FR", , , "[lstClasse]='" & Me.txtCLASSE & "' AND [lstAnnee]='" & Me.txtANNEE & "' AND [LstCompositions]=" & Me.txtCOMPO & "' AND [ID_ETABL_FREQ]=" & Me.Txt_EtablissementFr & "", , , "PF"
'DoCmd.OpenForm stDoc, , , "[ClasseFrancais]='" & Me.lstCLASSES_FR_DISPO & "' AND [ANNEE_SCOL]='" & Me.lstANNEE_SCOLAIRE & "'", , , "PF"
DoCmd.Close acForm, "frmIMPORTER_NOTES_FichEXCEL_Fr"
rst.Close
rstEleve.Close
Set rst = Nothing
Set rstEleve = Nothing
' Supprime la Table temporaire.
dbs.Execute "DROP TABLE " & strNomTable & ";"
DoCmd.SetWarnings True
End If
End Sub
Sub LierTableExcel()
Dim strNomTable As String
Dim Fichier As String
Dim Feuille As String
strNomTable = " Temp_Importation_NotesExcel_Fr "
Fichier = Me.sCheminFichier
Feuille = Me.ListeClasseurs & "!"
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, strNomTable, Fichier, True, Feuille
End Sub
Sub DelierTableExcel()
Dim strNomTable As String
strNomTable = " Temp_Importation_NotesExcel_Fr"
On Error Resume Next
DoCmd.DeleteObject acTable, strNomTable
End Sub |
Partager