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
| Private Sub Commande6_Click()
Dim date1 As Long
Dim date2 As Long
Dim qd As QueryDef
Dim strFileName As String
Dim strDate As String
'dans mon sous formulaire j'ai 2 zones de texte avec des dates car je récupére tous les enregistrements compris en tre 2 dates
date1 = Form_CG26!DTPicker1
date2 = Form_CG26!DTPicker3
'je récupére que le mois et l'année pour mettre dans le nom de mon fichier
strDate = Format(date1, "mmmmyyyy")
'je choisis l'emplacement de mon fichier ainsi que son nom et j'ajoute le mois avec l'année selectionné précédemment
strFileName = "F:\RécapitulatifCG_" & strDate & ".xls"
'je séléctionne et j'exporte les données de ma tables vers mon fichier excel en créant une feuille cg26
Set qd = CurrentDb.CreateQueryDef("CG26", "SELECT Civilité, Nom, Prénom, Téléphone, Adulte, Enfant, Secteur, Transporteur, Date_trajet_aller, Départ, Heure_départ, Arrivée,Heure_arrivée,Observations FROM T_trajet_aller WHERE ((Date_trajet_aller) >= " & date1 & " and (Date_trajet_aller) <= " & date2 & ")ORDER BY Date_trajet_aller")
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "CG26", strFileName
DoCmd.DeleteObject acQuery, "CG26"
'la j'exporte une autre table vers excel dans une autre feuille
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "T_secteur", strFileName, True
Dim xls As Excel.Application
Dim sTempSheetName As String
Set xls = CreateObject("Excel.Application")
xls.Workbooks.Open strFileName
xls.Visible = True
'je fais une mise en page de ma derniére feuille ajoutée
xls.Sheets("T_secteur").Rows(1).Delete
xls.Sheets("T_secteur").Rows(1).Delete
xls.Sheets("T_secteur").Cells(1, 1).EntireColumn.Delete
xls.Sheets("T_secteur").Activate
Dim i As Integer
Dim j As Integer
' je vérifie dans la colonne A toutes les lignes non vides
For i = xls.Sheets("T_secteur").Range("A65536").End(xlUp).Row To 1 Step -1
If IsEmpty(xls.Sheets("T_secteur").Cells(i, 1).Value) Then
Else
'j'ajoute une feuille pour chauqe cellule non vides trouvées
xls.Sheets.Add
'je donne le nom de la cellule à la feuille crée
xls.ActiveSheet.Name = xls.Sheets("T_secteur").Cells(i, 1).Text
For j = xls.Sheets("_CG26").Range("G65536").End(xlUp).Row To 2 Step -1
If IsEmpty(xls.Sheets("_CG26").Cells(j, 7).Value) Then
Else
xls.Sheets("_CG26").Rows(j).Cut
'pour chaque feuille qui viens d'être crées, si dans la colonne de ma feuille cg26, la valeur correspond au nom de la feuille, je coupe les données et je les colle dans la feuille du même nom et ensuite je fais de la mise en page
If xls.ActiveSheet.Name = xls.Sheets("_CG26").Cells(j, 7).Text Then
xls.ActiveSheet.Cells(2, 1).Select
xls.ActiveSheet.Paste
xls.Range("A1:O1").EntireRow.Insert Shift:=xlShiftDown
xls.Sheets("_CG26").Rows(1).Copy
End If
End If
Next j
xls.Sheets("_CG26").Rows(1).Copy
xls.ActiveSheet.Cells(1, 1).Select
xls.ActiveSheet.Paste
xls.ActiveSheet.Rows(1).Select
Selection.HorizontalAlignment = xlCenter
Selection.Font.Bold = True
xls.ActiveSheet.Columns.AutoFit
End If
Next i
End Sub |
Partager