使用直到直到Excel到PPT

Question

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

我想要的是根据我的图纸范围连续创建一个新证书。问题是我有空白行，总共有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\01_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\01_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上的

1. TextBox的编号（用于名称）是从“ TextBox 13”开始的。可以从格式选择窗格中修改TextBox名称。

2. 在Excel工作表Automation的J列中（从第114行开始）找到名称。

3. 两个名称之间可能有多个空白行。

尝试修改后的代码并按假设进行操作

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

希望它会有用。