Discussion :

[maclolo2]

bonjour,

Je souhaiterai savoir si c'est possible de creer le meme nombre de feuille que ma zone de liste access (ou ma table qui est lié à cette zone de liste) comporte et de leur attribuer le nom de chacune des lignes avec une macro access.
je sais pas si j'ai été clair.

merci

[ClaudeLELOUP]

Bonjour,

Avec une macro, j'ignore si c'est possible.

Mais si tu manipules un peu le code, vois cet exemple de LedZeppII.

[maclolo2]

Je vais essayer, je vous répondrai pour savoir si ca marche.

merci

[maclolo2]

bonjour,
je réponds à ce message pour vous donner la solution, j'ai réussi à creer dans un classeur excel des feuilles en fonction du contenu de ma table access.
voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

voila c'est un peu long mais j'y suis arrivé.

bonne journée

[ClaudeLELOUP]