Discussion :

[toto92]

bonjour

Je suis en train de creer un macro VB pour creer :

1) Sauvetage d'un fichier "Report_on_Critical_Fields.xls" en "Report_on_Critical_Fields.xlsx" ( c'est un fichier DATA avec 1 onglet "CI Changes")

2) Ouvrir un fichier "Liste des techniciens.xlsx" ( il y a 2 onglets "NDG" et "HNDG" ) ( c'est un fichier CRITERES)

3 ) Ré-Ouvrir "Report_on_Critical_Fields.xlsx" + Creation de 2 onglets "DataNDG" et "DataHNDG" ( Rappel : i y a deja 1 onglet "CI Changes" )

4) Dans ce fichier "Report_on_Critical_Fields.xlsx" : Creer un filtre avancé pour filtrer les données de l'onglet "CI Changes" vers "DataNDG" ( à partir de l'onglet "NDG" du fichier "Liste des techniciens.xlsx")

5) Dans ce fichier "Report_on_Critical_Fields.xlsx" :Creer un filtre avancé pour filtrer les données de l'onglet "CI Changes" vers "DataHNDG" ( à partir de l'onglet "HNDG" du fichier "Liste des techniciens.xlsx")

Ca ne marche pas ! code erreur = 1004 ! le macro s'arrete dans la "zone qui coince !" ( Voir mon fichier "Traitement_Report_on_Critical_Fields.xlsm" )


Je suis sous Windows 7 x32 bits + Excel 2010

ci joint 3 fichiers dont 1 "Traitement_Report_on_Critical_Fields.zip"
En fait c'est un fichier XLSM que j'ai du zipper car votre site ne semble pas accepter les XLSM


Merci & Bonne soirée !

[Philippe Tulliez]

Bonsoir,

Ca ne marche pas ! code erreur = 1004 ! le macro s'arrete dans la "zone qui coince !" ( Voir mon fichier "Traitement_Report_on_Critical_Fields.xlsm" )

Il serait intéressant d'afficher le code VBA utilisé avec les commentaires nécessaires à sa compréhension et indiquer le n° de ligne où a lieu l'erreur.

[Invité]

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
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
Sub Macro2()
Dim Wb As Workbook
Dim RonCriFilds As Workbook
Dim LstThec As Workbook
Set Wb = ActiveWorkbook
'  Set RonCriFilds = Workbooks.Open(Filename:= _
'        "D:\Tests Excel\Report_on_Critical_Fields.xls")
 Set RonCriFilds = Workbooks.Open(Filename:= _
       Wb.Path & "\Report_on_Critical_Fields.xls")
 
       RonCriFilds.Sheets("CI changes").Select
    RonCriFilds.Sheets("CI changes").Rows("1:1").Delete Shift:=xlUp
     RonCriFilds.Sheets("CI changes").Columns("A:A").Delete Shift:=xlToLeft
    RonCriFilds.Sheets("CI changes").Cells.Columns.AutoFit
    With RonCriFilds.Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Application.ActiveWindow.FreezePanes = True
    RonCriFilds.Sheets("People changes").Select
      RonCriFilds.Sheets("People changes").Rows("1:1").Delete Shift:=xlUp
    RonCriFilds.Sheets("People changes").Columns("A:A").Delete Shift:=xlToLeft
    RonCriFilds.Sheets("People changes").Cells.Columns.AutoFit
    With RonCriFilds.Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Application.ActiveWindow.FreezePanes = True
    RonCriFilds.Sheets("CI changes").Select
    RonCriFilds.Application.ActiveWindow.SmallScroll Down:=-15
'    RonCriFilds.Sheets("CI changes").Range("A1").Select
'    RonCriFilds.SaveAs Filename:= _
'        "D:\Tests Excel\Report_on_Critical_Fields.xlsx", _
'        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 RonCriFilds.Application.DisplayAlerts = False
 RonCriFilds.SaveAs Filename:= _
        Wb.Path & "\Report_on_Critical_Fields.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 RonCriFilds.Application.DisplayAlerts = True
'Set LstThec =Workbooks.Open( Filename:= _
'        "D:\Tests Excel\Liste des techniciens.xlsx")
'    Sheets("NDG").Select
'    Windows("Report_on_Critical_Fields.xlsx").Activate
 
Set LstThec = Workbooks.Open(Filename:= _
        Wb.Path & "\Liste des techniciens.xlsx")
 
    LstThec.Sheets("NDG").Select
   RonCriFilds.Activate
    '
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets("Feuil1").Name = "DataNDG"
 
    '
  RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets("Feuil2").Name = "DataHNDG"
    '
    ' debut de la zone qui coince !!
    '
    RonCriFilds.Sheets("DataNDG").Select
     RonCriFilds.Sheets("DataNDG").Range("A1").Select
    FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstThec.Sheets("NDG").UsedRange, RonCriFilds.Sheets("DataNDG").Range("A1"), False
'    Sheets("CI changes").Cells.AdvancedFilter Action:=xlFilterCopy, _
'    CriteriaRange:=Workbooks("Liste des techniciens.xlsx").Sheets("NDG").Range("A1:A10"), _
'    CopyToRange:=Range("DataNDG"), Unique:=False
    RonCriFilds.Sheets("DataHNDG").Select
    RonCriFilds.Sheets("DataHNDG").Range("A1").Select
     FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstThec.Sheets("HNDG").UsedRange, RonCriFilds.Sheets("DataHNDG").Range("A1"), False
'    Sheets("CI changes").Cells.AdvancedFilter Action:=xlFilterCopy, _
'    CriteriaRange:=Workbooks("Liste des techniciens.xlsx").Sheets("HNDG").Range("A1:A9"), _
'    CopyToRange:=Range("DataHNDG"), Unique:=False
'    ActiveWorkbook.SaveAs Filename:= _
'        "D:\Tests Excel\Report_on_Critical_Fields.xlsx", _
'        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
RonCriFilds.Application.DisplayAlerts = False
RonCriFilds.SaveAs Filename:= _
        Wb.Path & "\Report_on_Critical_Fields.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 RonCriFilds.Application.DisplayAlerts = True
RonCriFilds.Close False
LstThec.Close False
Set RonCriFilds = Nothing
Set LstThec = Nothing
Set Wb = Nothing
End Sub
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        On Error GoTo 0
End Function

[toto92]

c'est bon !


Merci beaucoup !

[toto92]

Apres ameliorations ( ajout d'un filtre avancé avec exclusion) et tests : ca ne marchait plus j'ai du remplacer UserRange par Range("A1:A1x") ca allait et puis ca ne marchait plus du tout meme en faisant marche arriere ( c'est à dire copier/coller à partir de votre code ) ! je ne comprends plus ! voulez vous bien que je soumets mes 3 fichiers à votre oeil expert ? ( note : www.developpez.net refuse les fichiers xlsm alors je l'ai zippé )
merci

[Invité]

bonjour,
ton fichier Report_on_Critical_Fields.xls est un XLS

[toto92]

oui .. je cherche a creer à partir de ce xls ( qui contient 2 onglets )
un xlsx ( avec 2 onglets + 3 onglets supplementaires )
je ne comprends pas tres bien car mon code ne s'est pas planté .. il est allé jusqu'au bout et comme resultat : dans le xlsx : j'ai les 2 premiers onglets ( = okay ) mais et les 3 derniers onglets = vide

[Invité]

comme je travail sauvant sur des automate placer sur un serveur, il n'y a personne pour cliquer sur Ok si apparait un message d'erreur.
d’où le On Error Resume Next et le If Err = 0 Then FiltreActif = True

Code :

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

1
2
3
4
5
6
7
8
9
10
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        On Error GoTo 0
End Function

Code :

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

If FiltreActif(RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("HNDG").UsedRange, RonCriFilds.Sheets("DataHNDG").Range("A1"), False) = False Then MsgBox "Err"

maintenant tu peux enregistre en XLSX ton fichier avant tout traitement et plus d'erreur.