imprimer idems TCD

[SOM58]

Bonsoir à tous

Dans TCD ci joint je souhaite imprimer les idems "date de livraison" on choisissant la date via un user form ,jusque la pas de probleme
j'ai trouvé un code sur le net d'un site anglais pour l'impression mais j'ai du oublié quelque chose
merci de votre collaboration et bonne soiree

som

Sub imprim()


Dim ws As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim str As String
Dim rng As Range
Dim c
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Set rng = Worksheets("feuil1").Range("A4:A370")

c = UserForm1.DTPicker1

For Each c In rng
Set pi = Nothing
str = c.Value
With pt.PageFields("date de livraison")
On Error Resume Next
Set pi = .PivotItems(str)
On Error GoTo 0
If pi Is Nothing Then
Debug.Print str & " was NOT printed"
Else
.CurrentPage = str
ws.PrintOut Preview:=True
End If
End With
Next c

End Sub

 

[Cousinhub]

Re : imprimer idems TCD

Bonsoir,

Tout d'abord, fais un clic droit, sur ton usf, puis, "Propriétés"

Pour ShowModal, sélectionne "False"

ensuite, remplace tout ton code par ceci :

module 1 :

Sub macro15()
UserForm1.Show
End Sub

et dans le code du Bouton Click :

Private Sub CommandButton1_Click()
Dim Flag As Boolean
Dim DerLig As Long
Dim Ws As Worksheet
Dim Pvi As PivotItem
Set Ws = Sheets("Feuil1")
Application.ScreenUpdating = False
With Ws
    DerLig = .[A65000].End(xlUp).Row
    On Error Resume Next
    Flag = .Range("A4:A" & DerLig).Find(UserForm1.DTPicker1)
    If Flag Then
        With .PivotTables("Tableau croisé dynamique1")
            For Each Pvi In .PivotFields("Date de livraison").PivotItems
                Pvi.Visible = IIf(Pvi = Me.DTPicker1, True, False)
            Next Pvi
            Ws.PrintPreview
            For Each Pvi In .PivotFields("Date de livraison").PivotItems
                Pvi.Visible = True
            Next Pvi
        End With
        Unload UserForm1
    Else
        MsgBox "Cette DATE n'existe pas"
        Exit Sub
    End If
End With
End Sub

PS : Remplace PrintPreview par Print, pour l'impression
le fichier joint, ci-dessous

 

[SOM58]

Re : imprimer idems TCD

merci beaucoup bh bh ,c'est impeccable là on reconnait les pros
bonne journée à tous