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
| Private Sub requete_email()
Dim db_Exemple As Database
Dim rs_Exemple As Recordset
Dim rq_Sql As String
Dim nb_Lignes As Long
Dim Nom_Feuille As String
Dim i As Integer
Dim l As Long
' OUVERTURE DE LA BASE DISTANTE
'Set db_Exemple = OpenDatabase("C:\travail\bdd_temoin.mdb")
Set db_Exemple = OpenDatabase(ActiveWorkbook.Path & "\bdd_temoin.mdb")
' REQUETE D'EXTRACTION DES DONNEES
rq_Sql = "SELECT * from email order by numéro"
Set rs_Exemple = db_Exemple.openrecordset(rq_Sql, dbopensnapshot)
' comptage du nbre de resultat
If rs_Exemple.RecordCount = 0 Then
nb_Lignes = 0
Else
rs_Exemple.MoveLast
nb_Lignes = rs_Exemple.RecordCount
End If
' message si aucun resultat
If nb_Lignes <= 0 Then
message_auccun_resultat
Else
' creation de la feuille receptrice
Nom_Feuille = "E-MAIL"
' si elle existe on la detruit
bool = False
For i = 1 To Sheets.Count
If Sheets(i).Name = Nom_Feuille Then
bool = True
feuille = i
End If
Next
If bool = True Then
Application.DisplayAlerts = False
Sheets(feuille).Delete
Application.DisplayAlerts = True
End If
'creation page
Sheets.Add.Move before:=Sheets(1)
Sheets(1).Name = Nom_Feuille
Sheets(1).Select
' ECRITURE DES NOMS DE COLONNES
Cells(1, 1).Value = "ID"
Cells(1, 2).Value = "EMAIL"
Cells(1, 3).Value = "NOM"
Cells(1, 4).Value = "PRENOM"
Cells(1, 5).Value = "FILIERE"
Cells(1, 6).Value = "DEPT"
Cells(1, 7).Value = "POSTE"
' NOMS DE COLONNES EN GRAS
Range("A1:G1").Select
Selection.Font.Bold = True
' REMPLISSAGE DE LA FEUILLE
rs_Exemple.MoveFirst
For l = 2 To nb_Lignes + 1
Cells(l, 1).Value = rs_Exemple.Fields("numéro")
Cells(l, 2).Value = rs_Exemple.Fields("Email")
Cells(l, 3).Value = rs_Exemple.Fields("Nom")
Cells(l, 4).Value = rs_Exemple.Fields("Prenom")
Cells(l, 5).Value = rs_Exemple.Fields("FILIERE")
Cells(l, 6).Value = rs_Exemple.Fields("DEPT")
Cells(l, 7).Value = rs_Exemple.Fields("POSTE")
rs_Exemple.MoveNext
Next
' FORMAT LARGEUR DE COLONNES
Columns("A:G").Select
Selection.Columns.AutoFit
' DEPLACEMENT DE LA FEUILLE
Sheets(1).Move after:=Sheets("MENU_MAIL")
' SELECTION DE LA 1ERE CELLULE POUR FAIRE PROPRE
Cells(1, 1).Select
End If
End Sub |
Partager