Question

我正在尝试自动化一个非常手动和烦人的过程。

情况：我在excel工作表中有一张表，其中包含工作簿中图表对象的源位置，它们的目标格式规范以及它们在给定Powerpoint上的目标位置。

到目前为止，我将代码设置如下。最终，我希望循环遍历表的整个单元格，并选择必要的细节来实现以下代码。理想情况下，将所有斜体替换为从表中提取的变量。

请帮助！！

EXEC dbo.TestProc 'foo'

Answer 1

使用您想要的变量作为参数来制作一个过程：

Sub MyProcedure(RangeTitle As String, SlideNumber As Long, SetLeft As Double, SetTop As Double, SetWidth As Double, SetHeight As Double)
    Dim shP As Object
    Dim myShape As Object
    Dim mySlide As Object
    Dim tempSize As Integer, tempFont As String

    Dim ws As Worksheet
    Set ws = Worksheets("Sheet 1")

    'select the name of report
    Set shP = ws.Range(RangeTitle)

    'select the ppt sheet you wish to copy the object to
    Set mySlide = PPT.ActivePresentation.slides(SlideNumber)

    'count the number of shapes currently on the PPT
    shapeCount = mySlide.Shapes.Count
    'copy the previously selected shape
    shP.Copy
    'paste it on the PPT
    mySlide.Shapes.Paste

    'wait until the count of shapes on the PPT increases, which signals that the past operation is finished.
    Do '<~~ wait completion of paste operation
        DoEvents
    Loop Until mySlide.Shapes.Count > shapeCount

    'adjust formatting of the newly copied shape: position on the sheet, font & size
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = SetLeft
        .Top = SetTop
        .Width = SetWidth
        .height = SetHeight
        .TextEffect.FontSize = 15
        .TextEffect.FontName = "Century Schoolbook"
    End With
End Sub

然后，您可以轻松地在循环中使用该过程：

Sub LoopThrougMyData()

    Dim iRow As Long
    For iRow = FirstRow To LastRow 'loop through your table here

        With Worksheets("YourDataTable")
            MyProcedure RangeTitle:=.Cells(iRow, "A"), SlideNumber:=.Cells(iRow, "B"), SetLeft:=.Cells(iRow, "C"), SetTop:=.Cells(iRow, "D"), SetWidth:=.Cells(iRow, "E"), SetHeight:=.Cells(iRow, "F")
            'call the procedure with the data from your table
        End With

    Next iRow

End Sub

编辑（请参阅评论）

我将为PPT文件添加另一个参数：

Sub MyProcedure(PPT As Object, RangeTitle As String, SlideNumber As Long, …

因此，您可以在LoopThrougMyData中打开PowerPoint并将其作为参数提供给过程MyProcedure

VBA循环遍历表

1 个答案: