Discussion :

[sodelp]

Bonjour,

Pourriez-vous svp m'aider à trouver une solution à mon problème de macro?

J'ai une base de données dans laquelle j'ai des informations pour 218 points de vente. Mon objectif est de créer un fichier excel par point de vente. J'ai tout d'abord créé un fichier excel template.

J'ai enregistré la macro ci-dessous en faisant un premier filtre sur le point de vente AIX CARNOT. Elle fonctionne très bien. Par contre, je ne sais pas maintenant comment faire pour le faire sur mes 217 autres points de ventes...
Il faudrait a priori créer un filtre automatique à partir d'une liste de mes 218 points de vente?

Pourriez-vous svp m'aider?

Je vous remercie par avance beaucoup pour votre aide.

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
ActiveSheet.Range("$A$5:$G$1444").AutoFilter Field:=1, Criteria1:= _
        "AIX CARNOT"
    Rows("99:831").Select
    Selection.Copy
    Windows("TEMPLATE.xls").Activate
    Rows("6:6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A10").Select
    ActiveWindow.SmallScroll Down:=-12
    Application.CutCopyMode = False
    ChDir "C:\Users\So & Gui\Desktop\OBJECTIFS"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\So & Gui\Desktop\OBJECTIFS\AIX CARNOT.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
    Windows("CAP_OBJECTIFS.xls").Activate
End Sub

[Theze]

Bonjour,

Tu peux demander en début de proc le nom du point de vente :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Dim Critere As String
 
Critere = InputBox("Indiquer le point de vente !", "Filtrage")
 
If Critere <> "" Then
 
    ActiveSheet.Range("$A$5:$G$1444").AutoFilter Field:=1, Criteria1:=UCase(Critere)
    'suite du code...
 
End If

Hervé.

[sodelp]

Bonjour,

Merci pour votre réponse, je vais essayer.

Par contre, je vais avoir le même soucis pour le nom de mon fichier en fin de macro.
Il n'est pas possible de le faire en automatique par rapport à une liste?

Par avance merci.

Sophie

[Theze]

Tu veux parler de la sauvegarde ? Tu peux utiliser une boite de dialogue (Application.FileDialog) pour demander à l'utilisateur le dossier où il veux enregistrer le fichier, un peut dans ce style là :

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
 
Sub Test()
 
    Dim Critere As String
    Dim Dossier As String
    Dim Fichier As String
 
    'demande le critère de tri
    Critere = InputBox("Indiquer le point de vente !", "Filtrage")
 
    If Critere <> "" Then
 
        ActiveSheet.Range("$A$5:$G$1444").AutoFilter Field:=1, Criteria1:=UCase(Critere)
        'suite du code...
 
    End If
 
    'exécute le filtrage, ici je pense que c'est issu de l'enregistreur de macros donc à voir si
    'ça correspond vraiment au résultat souhaité...
    ActiveSheet.Range("$A$5:$G$1444").AutoFilter Field:=1, Criteria1:=Critere
    Rows("99:831").Select
    Selection.Copy
    Windows("TEMPLATE.xls").Activate
    Rows("6:6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A10").Select
    ActiveWindow.SmallScroll Down:=-12
    Application.CutCopyMode = False
 
    'demande l'emplacement pour l'enregistrement du fichier
    With Application.FileDialog(4)
 
        .Show
 
        On Error Resume Next 'si annuler
        Dossier = .SelectedItems(1)
 
        If Err.Number <> 0 Then
 
            Dossier = Dossier & "\"
 
        Else
 
            MsgBox "Vous avez annulé, le fichier ne sera pas enregistré !"
            Exit Sub
 
        End If
 
    End With
 
    'construit le chemin complet
    Fichier = Dossier & Critere & ".xls"
 
    ActiveWorkbook.SaveAs Filename:=Fichier, FileFormat:=xlExcel8
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
    Windows("CAP_OBJECTIFS.xls").Activate
 
End Sub

Hervé.

[Philippe Tulliez]

Bonjour,
Voir cette discussion qui répond je pense à ta requête.

[Invité]

Bonjour,

Pourriez-vous svp m'aider à trouver une solution à mon problème de macro?

J'ai une base de données dans laquelle j'ai des informations pour 218 points de vente. Mon objectif est de créer un fichier excel par point de vente. J'ai tout d'abord créé un fichier excel template.

Tu dis que tu as une base de données? quelle type de base de données?
tout d'abord tu as créé un fichier excel template; j'imagine que tu accèdes à cette base de données via une connexion ADO ou DAO et que tu récupères tes data via une requête SQL?

si c'est le cas, pourquoi ne pas faire avec 2 requêtes une pour connaitre tes 281 points de vente et une autre pour extraire que le donné d'un point de vente le code suivant est juste pour te donner une idée il devra être adapté à ton cas:

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
Sub Test()
Sql = "Select Distinct Vente.PointsVente from Vente;"
Dim Rs_PointsVente As ADODB.Recordset
Set Rs_PointsVente = CreateObject("ADODB.Recordset")
Rs_PointsVente.Open Sql, connexion
While Rs_PointsVente.EOF
    Sql = "Select Vente.* from Vente where Vente.PointsVente='" & Rs_PointsVente!PointsVente & "';"
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open Sql, connexion
    If rs.EOF = False Then
        'traitement template par point de vente
    End If
    rs.Close
    Set rs = Nothing
    Rs_PointsVente.MoveNext
Wend
End Sub

bien sur il faut que tu confirme l'origine de tes données (Base de données?)