Excel в PPT с помощью До - PullRequest
Новая
       24

Excel в PPT с помощью До

0 голосов
/ 19 декабря 2018

Я делаю макрос, который вводит ИМЯ в текстовое поле PPT, а затем сохраняет в формате PDF.Итак, как мне выполнить цикл или сделать до тех пор, пока мой код не будет.

Что я хочу, так это непрерывно создавать новый сертификат на основе моего диапазона листов.Проблема в том, что у меня есть пустые строки в общей сложности 10 входных ячеек и 9 пустых ячеек, потому что это 1 ячейка друг от друга.И как зациклить только этот код ppPres.Slides(1).Shapes("TextBox 13").TextEffect.Text = sh1.Range("114").Text Как если бы я ввел 7 имен, он сгенерирует 7 pdf с 7 разными именами Обновленный код: 

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

1 Ответ

0 голосов
/ 19 декабря 2018

В коде есть несколько проблем, и вопрос о нескольких проблемах не ясен.Однако при условии, что

  1. Номера TextBox (для Имен) на слайде 1 находятся в последовательности, начиная с «TextBox 13».Имена TextBox могут быть изменены из панели выбора формата.

  2. Имена находятся в столбце J таблицы Excel. Автоматизация, начиная со строки 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

Надеюсь, это будет полезно.

...