Question

我创建了一个宏，该宏创建表格，一个Powerpoint，然后将其复制并粘贴到幻灯片上。但是有时候，代码会跳过我复制此表的行（table.copy）。我在这些行跳过中找不到任何规律性。当我多次编写此行时，我的程序可以完美运行。否则，它有时会停在应该粘贴表的行，并说“指定的数据类型不可用”。然后，我将光标替换到上一行（“复制”）上，并且它可以工作到下一次相同的情况。如果有任何想法，非常感谢！

Sub CreatePPT()

'Declare the variables
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim oldProduct As String
    Dim Product As String
    Dim MN As String 'month number
    Dim Year As String
    Dim Cluster As String
    Dim i As Integer
    Dim KPIindex As Integer
    Dim table As Range

'actualisation oldProduct (to be replaced in KPI table)
    oldProduct = ActiveWorkbook.Worksheets(3).Cells(28, 14)

'Select Global Slicers
    Cluster = InputBox("Cluster")
    MN = InputBox("Please enter month number (ex 05)")
    Year = InputBox("Please enter year (ex 2018)")
    KPIindex = slicerCountry(Cluster)
    slicerDate MN, Year

'Create a new PowerPoint
    Set newPowerPoint = New PowerPoint.Application
'Make a presentation in PowerPoint
    newPowerPoint.Presentations.Add

'Loop on the products
For i = 1 To 6

    'Change slicer and actualisation order type
    Product = slicerProduct(i)

    If i > 1 Then 'close former KPI file
        Name = oldProduct & " KPI.xlsx"
        Workbooks(Name).Close (False)
    End If

    'Open current KPI file, then reactivate working file
    Filename = "C:\Users\moi\Documents\" & Product & " KPI.xlsx"
    Workbooks.Open (Filename)
    Windows("charlotte.xlsm").Activate

    'actualisation of the europe global KPI table according to the product
    Application.Goto Reference:="KPI"
        Selection.Replace What:=oldProduct, Replacement:=Product, LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    oldProduct = Product
    ActiveWorkbook.Worksheets(3).Cells(28, 14) = oldProduct

'Set up KPI local table with the datas imported on KPIs sheet from the corresponding KPI file
    ActiveWorkbook.Worksheets(1).Cells(63, 21) = ActiveWorkbook.Worksheets("KPIs").Cells(18, KPIindex)
    ActiveWorkbook.Worksheets(1).Cells(64, 21) = ActiveWorkbook.Worksheets("KPIs").Cells(19, KPIindex)
    ActiveWorkbook.Worksheets(1).Cells(68, 21) = ActiveWorkbook.Worksheets("KPIs").Cells(24, KPIindex)
    ActiveWorkbook.Worksheets(1).Cells(69, 21) = ActiveWorkbook.Worksheets("KPIs").Cells(25, KPIindex)
    ActiveWorkbook.Worksheets(1).Cells(73, 21) = ActiveWorkbook.Worksheets("KPIs").Cells(29, KPIindex)
    ActiveWorkbook.Worksheets(1).Cells(74, 21) = ActiveWorkbook.Worksheets("KPIs").Cells(30, KPIindex)
    ActiveWorkbook.Worksheets(1).Cells(75, 21) = ActiveWorkbook.Worksheets("KPIs").Cells(31, KPIindex)

'Add a new slide for the orders related to the current product (charts & tables & title & comments)
    newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
    newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
    Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
    activeSlide.Shapes(2).TextFrame.TextRange.Text = Product & " - Orders"
    activeSlide.Shapes(1).TextFrame.TextRange.Text = "Comments"

'Copy the table of top five orders and paste it into the PowerPoint as a Metafile Picture
    Set table = Range("top_five")
    table.Copy
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

'Adjust the positioning of the table on Powerpoint Slide
    activeSlide.Shapes(3).Width = 263
    activeSlide.Shapes(3).Left = 230
    activeSlide.Shapes(3).Top = 270


'Copy the table of HTD Orders and paste it into the PowerPoint as a Metafile Picture
    Set table = Range("growth")
    table.Copy
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

'Adjust the positioning of the table on Powerpoint Slide
    activeSlide.Shapes(4).Width = 261
    activeSlide.Shapes(4).Left = 230
    activeSlide.Shapes(4).Top = 70

'Copy the table of KPI and paste it into the PowerPoint as a Metafile Picture
    Set table = Range("ClusterKPI")
    table.Copy
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

'Adjust the positioning of the table on Powerpoint Slide
    activeSlide.Shapes(5).Width = 200
    activeSlide.Shapes(5).Left = 20
    activeSlide.Shapes(5).Top = 96



    Next

'close the last KPI file opened
Name = oldProduct & " KPI June.xlsx"
Workbooks(Name).Close (False)

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

End Sub

我已经看到它是其他人的解决方案，但是我已经在宏设置中进行了验证，并且“信任对VBA对象模型的编程访问”处于打开状态...

由于这绝对不是正确的解决方案，只能连续粘贴10次同一行代码，希望不会跳过其中之一，如果有人可以使用“ On Error GoTo”工具帮助我，它也会会很有帮助，因为我试图写

Set table = Range("ClusterKPI")
    table.Copy
    On Error GoTo 135 'where 135 is the number of the previous line
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

但是出现了编译错误：标签未定义。

再次感谢

Answer 1

Excel复制和粘贴数据的速度如此之快，以至于需要一些时间来切换应用程序。

在粘贴值之前尝试添加以下代码

Application.Wait(Now + TimeValue("0:00:02")) '2 represents 2 seconds

Answer 2

使用With-End With语句来避免选择：

代替

activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
activeSlide.Shapes(3).Width = 263
activeSlide.Shapes(3).Left = 230
activeSlide.Shapes(3).Top = 270

您可以使用：

With activeSlide
    .Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
    .Shapes(3).Width = 263
    .Shapes(3).Left = 230
    .Shapes(3).Top = 270
End With

也许没有必要在application.wait中构建

VBA Excel过程不执行所有行

2 个答案: