VBA - Prb Filtre TCD entre 2 dates par TextBox

naru31 · 1 Septembre 2011

Bonjour à tous,

Voilà, je suis bloqué sur mon code VBA sous Excel 2007 depuis quelques jours. Je souhaiterais effectuer un filtrage de mon TCD via des dates inscrites dans 2 TextBox sur un UserForm donnant la date d'entrée et la date de sortie entre lesquelles le filtre doit cocher que cette période et me décocher les autres.😕
J'ai voulu adapté un code que j'utilise déjà pour effectuer une recherche via les numéros de semaine (ce code est opérationnel) mais cela me met une Erreur d'exécution '1004' : Impossible de définir la propriété Visible de la classe PivotItem.😡
Je sais que les dates des TextBox sont au format en anglais donc je les écrit en anglais pour l'instant. (d'ailleur, si quelqu'un à une idée, je veux bien la solution🙂)
Et je sais que lors de la phase de filtre, il me les recouche toutes sauf la vide.😡

Code:

    '=========================================================
'Statements
'-------------------------------------------------------------------------------------------------
    Dim graph As Object     'selection old graphic
    Dim NDateF                   'selection date From
    Dim NDateT                   'selection date To
    Dim FdateF As Object    'filter TCD
'=========================================================
    
    '=========================================================
'Boots
'-------------------------------------------------------------------------------------------------
NDateF = From_T_D.Value    'TextBox1
NDateT = To_T_D.Value        'TextBox2
'=========================================================

' initialization Table Activity
    Sheets("Activity").Select
    Application.ScreenUpdating = False
    With ActiveSheet.PivotTables("Table Activity").PivotFields("Date")
        For Each FdateF In .PivotItems
            FdateF.Visible = False
        Next
    
' filter Week Number
        On Error Resume Next
        For Each FdateF In .PivotItems
            If FdateF.Name > NDateF And FdateF.Name < NDateT Then FdateF.Visible = True
        Next
    End With
    Application.ScreenUpdating = True
    ActiveSheet.PivotTables("Table Activity").PivotCache.Refresh
End If

Merci d'avance

Pierrot93 · 1 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Bonjour,

petite remarque au passage, si tu veux masquer tous les items d'un champ :

Code:

For Each FdateF In .PivotItems
            FdateF.Visible = False
        Next

cela te renverra une erreur, car au moins un item doit rester visible....

bonne journée
@+

naru31 · 1 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

merci Pierrot93, je comprend un peu mieux mais comment fait-on alors pour faire un "sauf" une valeur

Pierrot93 · 1 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Re,

bah... généralement on affiche tous les items et ensuite, par critère on masque ceux que l'on ne veut pas voir.... en fait faire la démarche inverse que celle effectuée par ton code...

naru31 · 1 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

J'ai inversé mon code mais j'ai toujours la même erreur

naru31 · 1 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Enfin j'ai réussi à faire un début de correction 😉:

Code:

With ActiveSheet.PivotTables("Table Activity").PivotFields("Date")

Dans ce filtre de mon TCD : .PivotFields("Date"), VBA prend ce "Date" comme un objet de sa bibliothèque au lieu de le prendre comme un champ du TCD. Donc je l'ai remplacé par "Dte" dans mon tableau d'origine, j'ai actualisé mon TCD et changé ce champ et enfin, j'ai modifié mon code. 😛

Code:

With ActiveSheet.PivotTables("Table Activity").PivotFields("Dte")

Le message d'erreur reste cependant existant car il ne reconnait pas les dates des TextBOX (même les dates au format anglais (mm/dd/yyyy)). L'astuce se trouve dans le format des dates à transformer en format standard ("generale" sous VBA). 😛

Quelqu'un aurait une astuce pour transformer une date anglaise d'une textbox en date française puis la mettre au format standard ? 😕

naru31 · 2 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Bon j'ai réussi à transformer ma date anglaise en française d'une manière très moche mais fonctionnel 😉 :

Code:

' extract date TextBox and convert in french and standard
    Range("K1").Select
    Range("K1").Value = CDteF
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "=DATE(YEAR(RC[-1]),DAY(RC[-1]),MONTH(RC[-1]))"
    Selection.NumberFormat = "General"
    Range("K2").Select
    Range("K2").Value = CDteT
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=DATE(YEAR(RC[-1]),DAY(RC[-1]),MONTH(RC[-1]))"
    Selection.NumberFormat = "General"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = _"=IF(RC[-1]="""","""",INT(MOD(INT((RC[-1]-2)/7)+0.6,52+5/28))+1)"

' convert date Activity in standard
    Sheets("Activity").Select
    Columns("C:C").Select
    Selection.NumberFormat = "General"
    ActiveSheet.PivotTables("Table Activity").PivotCache.Refresh

Donc, suite à ça, les filtres de mes TCD et les cellules L1 et L2 sont au format standard et non en dates. Le filtre doit se faire via les valeurs des 2 cellules mais il me met encore le même message d'erreur :

Erreur d'exécution '1004' : Impossible de définir la propriété Visible de la classe PivotItem

Et cela aux .Visible se trouvant dans les boucles For Each...Next n'ayant pas "On Error Resume Next" d'écrit juste avant. Dans le cas ou il est écrit, la macro saute la boucle et ne fait rien de plus. 😡

Et inverser les True et les False comme Pierrot93 expliqué, cela ne fait rien du tout. 😡

Code:

Private Sub Extract_B_D_Click()

'Statements
'-------------------------------------------------------------------------------------------------
    Dim graph As Object     'selection old graphic
    Dim NDteF               'selection date From
    Dim NDteT               'selection date To
    Dim FdteF As Object     'filter date
    Dim FWeek As Object     'filter week
    Dim CDteF               'convert date From
    Dim CDteT               'convert date To

'Boots
'-------------------------------------------------------------------------------------------------
    CDteF = From_T_D.Value 'TextBox1
    CDteT = To_T_D.Value 'TextBox2
    NDteF = Sheets("Indicator").Range("L1").Value
    NDteT = Sheets("Indicator").Range("L2").Value
    
        
    ' extract date TextBox and convert in french and standard
    Range("K1").Select
    Range("K1").Value = CDteF
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "=DATE(YEAR(RC[-1]),DAY(RC[-1]),MONTH(RC[-1]))"
    Selection.NumberFormat = "General"
    Range("K2").Select
    Range("K2").Value = CDteT
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=DATE(YEAR(RC[-1]),DAY(RC[-1]),MONTH(RC[-1]))"
    Selection.NumberFormat = "General"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",INT(MOD(INT((RC[-1]-2)/7)+0.6,52+5/28))+1)"
      
    ' convert date Activity in standard
    Sheets("Activity").Select
    Columns("C:C").Select
    Selection.NumberFormat = "General"
    ActiveSheet.PivotTables("Table Activity").PivotCache.Refresh

  
'Activity
'-------------------------------------------------------------------------------------------------

    ' initialization Table Activity
    Sheets("Activity").Select
    Application.ScreenUpdating = False
    With ActiveSheet.PivotTables("Table Activity").PivotFields("Dte")
        [COLOR="lime"]On Error Resume Next[/COLOR]
        For Each FdteF In .PivotItems
            [COLOR="red"]FdteF.Visible = True[/COLOR] 
        Next
    
    ' filter Date
        For Each FdteF In .PivotItems
            On Error Resume Next
            [COLOR="red"]If FdteF.Name > NDteF Then FdteF.Visible = False
            If FdteF.Name < NDteT Then FdteF.Visible = False[/COLOR] 
        Next
    End With
    Application.ScreenUpdating = True
    ActiveSheet.PivotTables("Table Activity").PivotCache.Refresh
    
End if
End sub

Alors que j'utilise un code équivalent pour effectuer un filtre par un autre champ (N°semaine), et je n'ai aucun problème !!! 😕

Code:

Private Sub Extract_B_W_Click()

    Dim NWeek               'selection week
    Dim FWeek As Object     'filter week

    NWeek = Week_T_W.Value

    'Activity
'-------------------------------------------------------------------------------------------------
' initialization Table Activity
    Sheets("Activity").Select
    Application.ScreenUpdating = False
    With ActiveSheet.PivotTables("Table Activity").PivotFields("Date Week")
        For Each FWeek In .PivotItems
            FWeek.Visible = True
        Next
    
    ' filter Week Number
        On Error Resume Next
        For Each FWeek In .PivotItems
            If FWeek.Name <> NWeek Then FWeek.Visible = False
        Next
    End With
    Application.ScreenUpdating = True
    ActiveSheet.PivotTables("Table Activity").PivotCache.Refresh
       
    End If
End Sub

Là je sèche vraiment !!!😡 Helpppp meeeeeee please

Compte Supprimé 979 · 2 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Bonsoir Naru31,

Sans fichier, cela me parait difficile de t'aider

A+

naru31 · 2 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Désolé mais j'hésitais un peu à le joindre comme c'est à but professionnelle mais bon de toute manière je suis bloqué et je ne suis aps le seul à faire cela. 😱
En même temps, vous pourrez me dire ce que vous en pensez. 🙂

Pour activer la macro en question (=mon problème), c'est à la feuille "Indicator", via le bouton [Extract] et dans [From date to date] (Userform ByDate)

naru31 · 3 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Bonjour,
J'effectue un petit "up" car je bloque toujours ? si il vous manque des informations ou des explications; n'hesitez pas 😀

naru31 · 8 Septembre 2011

Re : VBA - Prb Filtre TCD entre 2 dates par TextBox

Bonjour,
Personne a des solutions ????

Effectuez une recherche sur Excel Downloads...

VBA - Prb Filtre TCD entre 2 dates par TextBox

naru31

XLDnaute Nouveau

Pierrot93

XLDnaute Barbatruc

naru31

XLDnaute Nouveau

Pierrot93

XLDnaute Barbatruc

naru31

XLDnaute Nouveau

naru31

XLDnaute Nouveau

naru31

XLDnaute Nouveau

Compte Supprimé 979

Guest

naru31

XLDnaute Nouveau

Pièces jointes

naru31

XLDnaute Nouveau

naru31

XLDnaute Nouveau

Discussions similaires

Nous accordons de l'importance à votre vie privée