Excel 使用 Do Until 制作 PPT

Question

我正在做一个宏，将名称输入到 PPT 文本框中，然后另存为 pdf。那么我该如何循环，或者直到我的代码。

我想要的是根据我的 sheet 范围不断创建新证书。问题是我有总共 10 个输入单元格和 9 个空白单元格的空白行，因为它们相隔 1 个单元格。我如何只循环此代码 ppPres.Slides(1).Shapes("TextBox 13").TextEffect.Text = sh1.Range("114").Text 就像我输入 7 个名字一样，它会生成 7 个带有 7 个不同名字的 pdf 更新代码：

Dim fpath As String
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = ThisWorkbook.Worksheets("Automation")
Set sh2 = ThisWorkbook.Worksheets("Links")
fpath = "C:\Mondee_Automation\Project - Automated Letters\Thank You Award_AUNZ.pptx"
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = True
Set ppPres = ppApp.Presentations.Open(fpath)
ppPres.Slides(1).Shapes("TextBox 21").TextEffect.Text = sh1.Range("J111").Value 'do not need to loop
Dim I As Long, LastRow As Long, TbNo As Long
LastRow = 132
I = 114
Do While I <= LastRow
    If sh1.Range("G" & I).Value <> "" Then
    ppPres.Slides(1).Shapes("TextBox 20").TextEffect.Text = sh1.Range("G" & I).Value 'name that need to loop
    sPath = "C:\Mondee_Automation\Project - Automated Letters\"
    sName = sh1.Range("G" & I).Value & ".pdf"
    ppPres.ExportAsFixedFormat sPath & sName, ppFixedFormatTypePDF
    ppPres.Close
    ppApp.Quit
    End If
I = I + 1
Loop
End Sub

Answer 1

代码中存在多个问题，多个问题的问题不清楚。但是假设

幻灯片 1 上的文本框编号（名称）是按顺序排列的，从 "TextBox 13" 开始。可以从格式选择窗格修改文本框名称。
名称位于 excel 的 J 列 sheet Automation 从第 114 行开始。
两个名字之间可能有多个空行。

已尝试修改后的代码并根据假设进行工作

Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = True
Set ppPres = ppApp.Presentations.Open(fpath)
ppPres.Slides(1).Shapes("TextBox 2").TextEffect.Text = sh1.Range("J111").Value 'do not need to loop

Dim I As Long, LastRow As Long, TbNo As Long
'last excel rows of the names may be ascertained by or directly defined 
LastRow = sh1.Range("J" & sh1.Range("J:J").Rows.Count).End(xlUp).Row

I = 114
TbNo = 13
Do While I <= LastRow
    If sh1.Range("J" & I).Value <> "" Then
    ppPres.Slides(1).Shapes("TextBox " & TbNo).TextEffect.Text = sh1.Range("J" & I).Value 'name that need to loop
    TbNo = TbNo + 1
    'save to pdf code will be added here
    End If
I = I + 1
Loop

希望有用。

Excel 使用 Do Until 制作 PPT

Excel to PPT with Do Until

excel

powerpoint

vba