【发布时间】:2018-07-17 10:59:04
【问题描述】:
我创建了一个宏来创建表格、一个电源点,然后复制表格并将它们粘贴到幻灯片上。 但有时,代码会跳过我复制此表 (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 对象模型的编程访问”已打开...
由于这绝对不是一个合适的解决方案,只需连续十次复制粘贴相同的代码行,希望其中一个不会被跳过,如果有人可以帮助我使用“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
但它得到一个编译错误:标签未定义。
再次感谢
【问题讨论】:
-
对
On Error语句的目标使用标签而不是行号。但是:重复执行刚刚抛出错误的行的代码听起来像是无限循环的秘诀。我无法想象这会很强大。 -
我现在明白我必须通过在开头显式写一个数字来标记我的行...所以现在它可以编译但即使使用下面的代码 + 135 也不会执行该行“table.Copy”行的开头......即使它有效,我同意这几乎是一个最佳解决方案!您是否认为@JohnColeman 这比复制粘贴行 table.Copy 的 6-7 倍还要糟糕?
-
一些注意事项:不要使用Excel/VBA' Product, Year, Table 已经使用的名称作为变量名,你可能会遇到问题。选择是“从不”必要的,所以尽量避免它,这种选择可能需要很长时间。
-
感谢您的相关评论 - 这是我的第一个宏,所以对我有很大帮助!但是我应该写什么而不是 select ?例如使用 SetShapesDefaultProperties 更好吗?
-
由于格式问题,我将在下面的答案中发布重写选择
标签: vba excel execution onerror