将格式化的表格从excel粘贴到ppt表示的macros会不正常地崩溃

我在Excel中创build了macros，使用Excel报表将大量表格复制并粘贴到Powerpoint演示文稿中。 使用“Keep source formatting”方法粘贴表格，如果字体较小，粘贴macros后将字体大小更改为7，并将表格放在幻灯片的正确位置。 问题是，macros在两个应用程序之间跳过，每个粘贴都耗时，所以有时macros会崩溃/冻结 – 例如，为同一个报表运行macros时，我收到不同的结果的次数不同 – 有时会成功地生成演示文稿几分钟后，幻灯片15上的macros崩溃，在另一次运行中幻灯片41上的崩溃，完全相同的报告。 有没有一种方法来运行macros作为后台进程来启用Excel的性能没有任何错误或任何方式，以避免Excel不时破碎…我将不胜感激任何意见/build议！

下面是我用来粘贴表格并在需要的表格范围被复制时改变字体大小的支持macros的代码：

Sub PastewithSourceFormatting_table(iSlide As Integer, table_name As Object) Dim shapes_number As Integer Dim shapes_number_new As Integer Dim v_size As Byte Dim row_num As Integer Dim col_num As Integer shapes_number_new = 0 shapes_number = 0 v_size = 0 row_num = 0 col_num = 0 Set PPSlide = PPPres.Slides(iSlide) PPSlide.Select shapes_number = PPSlide.Shapes.Count Do Until shapes_number_new = shapes_number + 1 With PPSlide PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting") Application.Wait (Now + TimeValue("0:00:01")) PPApp.CommandBars.ReleaseFocus shapes_number_new = .Shapes.Count End With Loop Application.Wait (Now + TimeValue("0:00:01")) Application.CutCopyMode = False Set table_name = PPSlide.Shapes.Item(shapes_number_new) '---------check font size v_size = table_name.Table.Cell(1, 1).Shape.TextFrame.TextRange.Font.Size row_num = table_name.Table.Rows.Count col_num = table_name.Table.Columns.Count If v_size < 7 Then Dim i, j As Integer For i = 1 To row_num For j = 1 To col_num If table_name.Table.Cell(i, j).Shape.TextFrame.HasText = msoTrue Then table_name.Table.Cell(i, j).Shape.TextFrame.TextRange.Font.Size = 7 End If Next j Next i Else End If Application.Wait (Now + TimeValue("0:00:01")) End Sub