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 CommandButton1_Click()
'Déclaration des variables
Dim Nbre As Integer
Dim i As Integer
Dim ColonneDeb As String
Dim LDeb As Integer
Dim ValCar As Integer
Dim ChoixCode As String
Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel
Dim wbEtudiant As Excel.Workbook
Dim wsEtudiant As Excel.Worksheet
'initialisation des variables
ColonneDeb = "B"
LDeb = 3
Nbre = 0
ChoixCode = ComboBox1.Value
'Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
'Ouverture d'un fichier Excel
Set wbExcel = appExcel.Workbooks.Open("D:\Mes documents\Développement\excel\Enquete_Eurequa\Résultat\Enquete.xls")
'wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)
'Appel de la fonction du calcul du nombre de fichier XLS à traiter
Nbre = Nbre_Fich("D:\Mes documents\Développement\excel\Enquete_Eurequa\", "*.xls")
wsExcel.Range("A1") = Nbre
'Changement du nom des fichiers dans le répertoire
Call Name_File(Nbre)
'Boucle permettant le remplissage des valeurs des étudiants
For i = 1 To Nbre
'Ouveture du document de l'étudiant
Set wbEtudiant = appExcel.Workbooks.Open("D:\Mes documents\Développement\excel\Enquete_Eurequa\evales_" & i & ".xls")
Set wsEtudiant = wbEtudiant.Worksheets(1)
'Test du code du cours
If (wsEtudiant.Range("C11").Value = ChoixCode Xor Code = 0) Then
'Sélection des valeurs à copier
wsEtudiant.Activate
wsEtudiant.Range("G29:G40").Copy
'Titre du Tableau
wsExcel.Activate
wsExcel.Range(ColonneDeb & (LDeb - 1)) = "Etudiant" & i
ActiveSheet.Paste ("B3")
'Passage Colonne suivante
ValCar = Asc(ColonneDeb)
ValCar = ValCar + 1
ColonneDeb = Chr(ValCar)
'Fermeture du document de l'etudiant
wbEtudiant.Close
Else
'Fermeture du document de l'etudiant
wbEtudiant.Close
End If
Next i
'fermeture de l'application
wbExcel.Close 'Fermeture du classeur Excel
appExcel.Quit 'Fermeture de l'application Excel
'Désallocation mémoire
Set wsExcel = Nothing
Set wbExcel = Nothing
Set appExcel = Nothing
End Sub |
Partager