时间戳

首页 > 解决方案 > VBA循环遍历表

excel - VBA循环遍历表

问题描述

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

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

到目前为止，我将代码设置如下。最终，我想要一个循环来遍历表格的整个单元格并获取必要的细节来完成下面的代码。理想情况下，用从表中提取的变量替换所有斜体。

请帮忙！！

Dim shP As Object
Dim myShape As Object
Dim mySlide As Object
Dim tempSize As Integer, tempFont As String

Worksheets("Sheet 1").Activate

'select the name of report
Set shP = Range(V.Title)

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

'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)

    myShape.Left = 254.016
    myShape.Top = 42.8085
    myShape.Width = 286.0515
    myShape.Height = 46.7775
    myShape.TextEffect.FontSize = 15
    myShape.TextEffect.FontName = "Century Schoolbook"

标签： excelvba

解决方案

使用所需的变量作为参数对其进行处理：

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, …

因此，您可以在其中打开 PowerPointLoopThrougMyData并将其作为参数提供给您的程序MyProcedure

推荐阅读