vba excel 过程未执行所有行

Question

我创建了一个宏来创建 tables，一个 power point，然后复制 tables 并将它们粘贴到幻灯片上。但有时，代码会跳过我复制此 table (table.copy) 的行。我在这些跳行中找不到任何规律。当我多次编写此行时，我的程序运行完美。否则，它有时会停在应该粘贴 table 的行并显示 "The specified data type is unavailable"。然后我将光标替换在前一行 ("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

我看到这是其他人的解决方案，但我已经在我的宏设置中进行了验证并且 "Trust programmatic access to VBA object model" 已打开...

因为这绝对不是正确的解决方案，只是连续十次复制粘贴相同的代码行，希望其中一个不会被跳过，如果有人可以帮助我使用 "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 过程未执行所有行

vba excel procedure not executing all lines

excel

vba

execution

onerror