我有一个VBA代码，该代码基本上将过滤器放在数据透视表上，然后根据某些设置将其复制到PowerPoint。
除了区域上的一种特定设置外，该代码运行良好。如果我在没有该区域的情况下运行宏，就可以了。
下面是完整的代码，高亮显示的行中出现错误。
ptTblCountry.PageFields（“ BUold”）。CurrentPage = tblSOP.Cells（r，iBUold）.Value
我已经检查了从名称到范围再到设置的所有内容，但找不到任何问题。
Sub CreatePowerPoint()
'Add a reference to the Microsoft PowerPoint Library by:
'1. Go to Tools in the VBA menu
'2. Click on Reference
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim TemplateFile As String
TemplateFile = Range("SOPtemplate")
Dim OutputPath As String
OutputPath = Range("SOPoutputPath")
Dim cht As Excel.ChartObject
Dim tblSOP As Range
Dim iGenerate, iIndex, iBMC, iMnth_lng, iMnth_sht, iFilename, iBU, iBUold, iMAG, iMAG_name, iCluster, iChannel, iSlideNr, iView As Integer
Set tblSOP = Range("tbl_SOP")
Dim sht As Worksheet
Set sht = Sheets("Run rate BMC S&OP")
Dim ptGrph As PivotTable
Set ptGrph = sht.PivotTables("ptSOP_RR")
Dim ptTblMAG As PivotTable
Set ptTblMAG = sht.PivotTables("ptSOP_MAG")
Dim ptTblAG As PivotTable
Set ptTblAG = sht.PivotTables("ptSOP_AG")
Dim ptTblCAG As PivotTable
Set ptTblCAG = sht.PivotTables("ptSOP_CAG")
Dim ptTblCountry As PivotTable
Set ptTblCountry = sht.PivotTables("ptSOP_Country")
Dim pi As PivotItem
Dim sVal As String
Dim s As Integer
Dim sChannel As String
Dim sCluster As String
Dim bChanged As Boolean
Dim TimeStart, TimeEnd
Dim iSlides As Integer
Dim sYear As String
'Record time of start
TimeStart = Now()
'Define column heading numbers in tblSOP
iGenerate = 1
iIndex = 2
iBMC = 3
iMnth_lng = 4
iMnth_sht = 5
iFilename = 6
iBU = 7
iBUold = 8
iMAG = 9
iMAG_name = 10
iCluster = 11
iChannel = 12
iSlideNr = 13
iView = 14
' 'Look for existing instance - if found, close it
' On Error Resume Next
' Set newPowerPoint = GetObject(, "PowerPoint.Application")
' On Error GoTo 0
MsgBox "Make sure that powerpoint is not open! Close ALL powerpoint screens!"
'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Show the PowerPoint
newPowerPoint.Visible = True
'Open template ppt
newPowerPoint.Presentations.Open TemplateFile
bChanged = False
For r = 1 To tblSOP.Rows.Count
'Check if this row in SOP_table needs to be executed. If not, skip copy actions
If tblSOP.Cells(r, iGenerate) = "N" Then GoTo SavePPT
'Adjust title slide
newPowerPoint.ActivePresentation.Slides(1).Shapes("BMC").TextFrame.TextRange.Text = tblSOP.Cells(r, iBMC)
newPowerPoint.ActivePresentation.Slides(1).Shapes("Month").TextFrame.TextRange.Text = tblSOP.Cells(r, iMnth_lng)
'Set pivot tables to right selection
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
bChanged = True
sYear = Right(tblSOP.Cells(r, iMnth_lng), 4) 'used for sorting pivot tables
'Filter pivot table for graph
ptGrph.PageFields("BU desc").CurrentPage = tblSOP.Cells(r, iBU).Value
ptGrph.PageFields("BUold").CurrentPage = tblSOP.Cells(r, iBUold).Value
ptGrph.PageFields("MAG").CurrentPage = tblSOP.Cells(r, iMAG).Value
ptGrph.PageFields("BMC").CurrentPage = tblSOP.Cells(r, iBMC).Value
ptGrph.PageFields("Cluster").CurrentPage = tblSOP.Cells(r, iCluster).Value
ptGrph.PageFields("Dchannel desc").CurrentPage = tblSOP.Cells(r, iChannel).Value
Select Case tblSOP.Cells(r, iView)
Case "MAG"
'Filter pivot table
ptTblMAG.PageFields("BU desc").CurrentPage = tblSOP.Cells(r, iBU).Value
ptTblMAG.PivotFields("BUold").ClearAllFilters
For Each pi In ptTblMAG.PivotFields("BUold").PivotItems
If pi = tblSOP.Cells(r, iBUold).Value Then pi.Visible = True Else pi.Visible = False
Next pi
ptTblMAG.PivotFields("MAG").ClearAllFilters
If tblSOP.Cells(r, iMAG).Value <> "(All)" Then
For Each pi In ptTblMAG.PivotFields("MAG").PivotItems
If pi = tblSOP.Cells(r, iMAG).Value Then pi.Visible = True Else pi.Visible = False
Next pi
End If
ptTblMAG.PageFields("BMC").CurrentPage = tblSOP.Cells(r, iBMC).Value
ptTblMAG.PageFields("Cluster").CurrentPage = tblSOP.Cells(r, iCluster).Value
ptTblMAG.PageFields("Dchannel desc").CurrentPage = tblSOP.Cells(r, iChannel).Value
'Sort pivot table
ptTblMAG.PivotFields("MAG").AutoSort xlDescending, "Total " & sYear & " "
Case "AG"
'Filter pivot table
ptTblAG.PageFields("BU desc").CurrentPage = tblSOP.Cells(r, iBU).Value
ptTblAG.PivotFields("BUold").ClearAllFilters
For Each pi In ptTblAG.PivotFields("BUold").PivotItems
If pi = tblSOP.Cells(r, iBUold).Value Then pi.Visible = True Else pi.Visible = False
Next pi
'
ptTblAG.PivotFields("MAG").ClearAllFilters
If tblSOP.Cells(r, iMAG).Value <> "(All)" Then
For Each pi In ptTblAG.PivotFields("MAG").PivotItems
If pi = tblSOP.Cells(r, iMAG).Value Then pi.Visible = True Else pi.Visible = False
Next pi
End If
' ptTblAG.PageFields("MAG").CurrentPage = tblSOP.Cells(r, iMAG).Value
ptTblAG.PageFields("BMC").CurrentPage = tblSOP.Cells(r, iBMC).Value
ptTblAG.PageFields("Cluster").CurrentPage = tblSOP.Cells(r, iCluster).Value
ptTblAG.PageFields("Dchannel desc").CurrentPage = tblSOP.Cells(r, iChannel).Value
'Sort pivot table
ptTblAG.PivotFields("MAG").AutoSort xlDescending, "Total " & sYear & " "
ptTblAG.PivotFields("AG").AutoSort xlDescending, "Total " & sYear & " "
Case "CAG"
'Filter pivot table
ptTblCAG.PageFields("BU desc").CurrentPage = tblSOP.Cells(r, iBU).Value
ptTblCAG.PageFields("BUold").CurrentPage = tblSOP.Cells(r, iBUold).Value
ptTblCAG.PageFields("MAG").CurrentPage = tblSOP.Cells(r, iMAG).Value
ptTblCAG.PageFields("BMC").CurrentPage = tblSOP.Cells(r, iBMC).Value
ptTblCAG.PageFields("Cluster").CurrentPage = tblSOP.Cells(r, iCluster).Value
ptTblCAG.PageFields("Dchannel desc").CurrentPage = tblSOP.Cells(r, iChannel).Value
'Sort pivot table
ptTblCAG.PivotFields("CAG").AutoSort xlDescending, "Total " & sYear & " "
Case "Country"
'Filter pivot table
ptTblCountry.PageFields("BU desc").CurrentPage = tblSOP.Cells(r, iBU).Value
------------> ptTblCountry.PageFields("BUold").CurrentPage = tblSOP.Cells(r, iBUold).Value
ptTblCountry.PageFields("MAG").CurrentPage = tblSOP.Cells(r, iMAG).Value
ptTblCountry.PageFields("BMC").CurrentPage = tblSOP.Cells(r, iBMC).Value
ptTblCountry.PivotFields("Cluster").ClearAllFilters
If tblSOP.Cells(r, iCluster) <> "(All)" Then
For Each pi In ptTblCountry.PivotFields("Cluster").PivotItems
If pi = tblSOP.Cells(r, iCluster).Value Then pi.Visible = True Else pi.Visible = False
Next pi
End If
ptTblCountry.PageFields("Dchannel desc").CurrentPage = tblSOP.Cells(r, iChannel).Value
'No need to sort - sorting clusters alphabetically
End Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'Select chart in the Excel worksheet and paste them into the PowerPoint
sht.Visible = xlSheetVisible
sht.Activate
Set cht = sht.ChartObjects("chart_SOP_RR")
'Add a new slide where we will paste the chart
s = tblSOP.Cells(r, iSlideNr)
newPowerPoint.ActivePresentation.Slides.Add s, ppLayoutText
newPowerPoint.ActiveWindow.View.GotoSlide s
Set activeSlide = newPowerPoint.ActivePresentation.Slides(s)
'Set the title of the slide
If tblSOP.Cells(r, iCluster) <> "(All)" Then sCluster = tblSOP.Cells(r, iCluster) & " " Else sCluster = ""
If tblSOP.Cells(r, iChannel) <> "(All)" Then sChannel = tblSOP.Cells(r, iChannel) & " " Else sChannel = ""
activeSlide.Shapes(1).TextFrame.TextRange.Text = "Demand Evolution " & sCluster & sChannel & "- " & tblSOP.Cells(r, iBUold) & " " & tblSOP.Cells(r, iMAG_name)
activeSlide.Shapes(2).TextFrame.TextRange.Text = "LM - " & vbNewLine & vbNewLine & vbNewLine & "Changes in Demand - " & vbNewLine & vbNewLine & vbNewLine & "AOB - "
'Copy the chart and paste it into the PowerPoint as a Metafile Picture
cht.Select
ActiveChart.ChartArea.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select 'Office2017
' activeSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile 'Office2013
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 11
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 70
newPowerPoint.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.78, msoFalse
'Copy the AG/MAG/CAG/Country pivot table from Excel
Select Case tblSOP.Cells(r, iView)
Case "MAG"
sht.PivotTables("ptSOP_MAG").TableRange1.Offset(-1, 0).Resize(ActiveSheet.PivotTables("ptSOP_MAG").TableRange1.Rows.Count + 1).Select
Case "AG"
sht.PivotTables("ptSOP_AG").TableRange1.Offset(-1, 0).Resize(ActiveSheet.PivotTables("ptSOP_AG").TableRange1.Rows.Count + 1).Select
Case "CAG"
sht.PivotTables("ptSOP_CAG").TableRange1.Offset(-1, 0).Resize(ActiveSheet.PivotTables("ptSOP_CAG").TableRange1.Rows.Count + 1).Select
Case "Country"
sht.PivotTables("ptSOP_Country").TableRange1.Offset(-1, 0).Resize(ActiveSheet.PivotTables("ptSOP_Country").TableRange1.Rows.Count + 1).Select
End Select
Selection.Copy
Application.Wait Now + TimeValue("0:00:02")
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select 'Office2018
' activeSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile 'Office2013
'Adjust the positioning of the AG/MAG table on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 0
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 321
newPowerPoint.ActiveWindow.Selection.ShapeRange.ScaleWidth 720 / newPowerPoint.ActiveWindow.Selection.ShapeRange.Width, msoFalse
newPowerPoint.ActiveWindow.Selection.ShapeRange.Fill.Solid
newPowerPoint.ActiveWindow.Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
newPowerPoint.ActiveWindow.Selection.ShapeRange.Fill.Visible = msoTrue
'Increase the amount of slides which are created until now
iSlides = iSlides + 1
SavePPT:
'Check if this was the last slide for this ppt. If so, adjust title slide and save
If tblSOP.Cells(r + 1, iIndex) <> tblSOP.Cells(r, iIndex) And bChanged Then
If newPowerPoint.Presentations.Count > 0 Then
'Adjust title slide
' newPowerPoint.ActiveWindow.View.GotoSlide 1
' newPowerPoint.ActivePresentation.Slides(1).Shapes("BMC").TextFrame.TextRange.Text = tblSOP.Cells(r, iBMC)
' newPowerPoint.ActivePresentation.Slides(1).Shapes("Month").TextFrame.TextRange.Text = tblSOP.Cells(r, iMnth_lng)
'Save and close presentation
newPowerPoint.ActivePresentation.SaveAs OutputPath & tblSOP.Cells(r, iFilename)
newPowerPoint.ActivePresentation.Close
End If
'If there is another ppt to be made, open the template
If r < tblSOP.Rows.Count Then
newPowerPoint.Presentations.Open TemplateFile
bChanged = False
End If
End If
Next r
Sheets("pptGen BMC S&OP").Activate
exito:
' AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
newPowerPoint.Quit
Set newPowerPoint = Nothing
sVal = Format(Now() - TimeStart, "Long time")
MsgBox "Ready!" & vbCrLf & iSlides & " slides created in " & sVal & " :-)", vbOKOnly
End Sub
Sub Pivot_ResetAllPageFieldCaptions()
'retrieve original field names
'if captions have been typed into pt
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Double
' On Error GoTo MyErr
Application.ScreenUpdating = False
For Each pt In Sheets("Run rate BMC S&OP").PivotTables
pt.ManualUpdate = True
For Each pf In pt.PageFields
'First set all captions to a random name (to prevent renaming to a name that is already taken)
i = 1
For Each pi In pf.PivotItems
pi.Caption = "asdfa" & i
i = i + 1
Next pi
'Now, reset all captions to source name
For Each pi In pf.PivotItems
pi.Caption = pi.SourceName
Next pi
Next pf
pt.RefreshTable
pt.ManualUpdate = False
Next pt
exitHandler:
Set pi = Nothing
Set pt = Nothing
Application.ScreenUpdating = True
MsgBox "Pivot tables reset ready!", vbOKOnly
Exit Sub
'Error stuff
MyErr:
If Err.Number = 1004 Then
MsgBox "You must place your cursor inside of a pivot table."
Else
MsgBox Err.Number & vbCrLf & Err.Description
GoTo exitHandler
End If
End Sub
```**strong text**