Opdatere rapportfilter Pivotdiagram + VBA Kode

Koden her forudsætter ugenummer er et heltal formateret som tekst.
Skriv hvis det virker, og hvis det ikke virker ;)


Sub Test()
Dim strWeekNr As String
strWeekNr = InputBox("Ugenummer", "Indtast", _
            WorksheetFunction.WeekNum(Date))

' angiv for hver pivottabel:
' arknavn, pivottabelnavn, feltnavn og ugenummer

' første
FilterPivotField "Sheet1", "PivotTable1", "UgeNr", strWeekNr
'anden
FilterPivotField "Sheet2", "PivotTable2", "UgeNr", strWeekNr
'Tredie
FilterPivotField "Sheet3", "PivotTable3", "UgeNr", strWeekNr

End Sub



Sub FilterPivotField(strWorksheet As String, _
                    strPivotTable As String, _
                    strField As String, _
                    Value As Variant)
On Error GoTo errHandling
    Dim oField As PivotField
    Worksheets(strWorksheet).Activate
    Set Field = _
        ActiveSheet.PivotTables(strPivotTable).PivotFields(strField)
    With Field
        If .Orientation = xlPageField Then
            .CurrentPage = Value
        End If
    End With
   
errHandling:
If Err.Number <> 0 Then
    MsgBox "Error: " & Err.Number & vbCr & _
          "Description: " & Err.Description
    Resume ExitSubHere
End If
ExitSubHere:
End Sub

Er det ikke også mere eller mindre det du har spurgt om i
Ændre i PivotDiagram vha. VBA Kode