VBA copy excel data range to powerpoint

Question

Я новичок в VBA/macro, и я хочу скопировать определенный диапазон данных в excel to powerpoint. Я искал этот сайт для кодов, и я нашел что-то, что идет в хорошем направлении (см. Ссылку ниже), но я не могу настроить его достаточно хорошо, чтобы заставить его работать, так как я не знаю достаточно языка.

Что мне нужно - это код, который выбирает один диапазон столбцов (> 150 ячеек) в Excel и вставляет каждую отдельную ячейку в существующий файл PowerPoint со слайда 3 и далее (ячейка A3 для слайда 3, A4 для слайда 4 и т. Д.) в правом углу.

copy text from Excel cell to PPT textbox

Моя версия аварии, когда я пытаюсь, например: ThisWorkbook.Sheets ("Rms") Range ("A3: A8").. Значение

Проблема может быть, что я не» t достаточно хорошо определить форму и/или дать правильный диапазон слайдов.

Если кто-нибудь может мне помочь, я был бы очень благодарен, спасибо заранее.

Answer 1

Я записал небольшую модификацию существующего кода из приведенной выше ссылки, которая соответствует вашим потребностям. Имейте в виду, что вам понадобится презентация с уже сохраненными слайдами и готовыми к заполнению данными из Excel. После вставки ячейки в каждый слайд на основе вашей логики ячейки A3 в слайде 3 вы можете перемещать вновь созданные фигуры с координатами слева и сверху.

Код:

Option Explicit 

Sub Sammple() 
    Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object 
    Dim oPPShape As Object 
    Dim FlName As String 
    Dim i as integer 

    '~~> Change this to the relevant file 
    FlName = "C:\MyFile.PPTX" 

    '~~> Establish an PowerPoint application object 
    On Error Resume Next 
    Set oPPApp = GetObject(, "PowerPoint.Application") 

    If Err.Number <> 0 Then 
     Set oPPApp = CreateObject("PowerPoint.Application") 
    End If 
    Err.Clear 
    On Error GoTo 0 

    oPPApp.Visible = True 

    '~~> Open the relevant powerpoint file 
    Set oPPPrsn = oPPApp.Presentations.Open(FlName) 

    for i=3 to ThisWorkbook.Sheets("RMs").Range("A65000").end(xlup).row 
    '~~> Change this to the relevant slide which has the shape 
    Set oPPSlide = oPPPrsn.Slides(i)   

    '~~> Write to the shape 

    ThisWorkbook.Sheets("RMs").Range("A" & i).CopyPicture Appearance:=xlScreen, _ 
Format:=xlPicture 

    oPPSlide.Shapes.Paste.Select 
    ' 
    '~~> Rest of the code 
    ' 
End Sub 

Answer 2

Как уже упоминалось Каталин, вы должны сначала создать презентацию и добавить достаточное количество слайдов для хранения данных, которые вы хотите вставить.

Sub AddSlideExamples() 

    Dim osl As Slide 

    With ActivePresentation 
     ' You can duplicate an existing slide that's already set up 
     ' the way you want it: 
     Set osl = .Slides(1).Duplicate(1) 

     ' Or you can add a new slide based on one of the presentation 
     ' master layouts: 
     Set osl = .Slides.AddSlide(.Slides.Count + 1, .Designs(1).SlideMaster.CustomLayouts(1)) 

    End With 

End Sub