Excel to Powerpoint using VBA

[bobaol]

hello, i want vba to copy my value in cell B1 and paste it to a new Powerpoint slide. I have the following; cell A1 has the value c:\tankman.jpg Cell B1 has the value June4th,1989. My Excel file is named Liberty.xlsm. My Powerpoint file is named Freedom.pptm. It is already open. So, this is how I would like it. I want to 1) Insert a new slide in Powerpoint, 2) insert into it the image from the file in A1, 3) insert the value into the slide (anywhere is fine) from A1 4) insert the value into the slide (anywhere is fine) from B1. any help is appreciated. Thanks in advance.

 

[JerrExcel]

Hi bobaol,

Lets say we have a few image to insert like below:

Liberty.xlsm
	A	B	C
1	C:\image1.jpg	Text1
2	C:\image2.jpg	Text2
3	C:\image3.jpg	Text3
4	C:\image4.jpg	Text4
5	C:\image5.jpg	Text5
6
Sheet1

Create a macro module in the excel, try the code below:

Option Explicit

Sub VBA_excel2ppt()
'excel is the host of VBA, put this macro in Excel

Dim PAplication As PowerPoint.Application
Dim Sld As PowerPoint.Slide

Dim DataRange As Range
Dim DataRow As Range
Dim DataColumn As Range

Dim oShape As PowerPoint.Shape
Dim oPicture As PowerPoint.Shape

Set PAplication = New PowerPoint.Application

PAplication.Visible = msoCTrue
PAplication.WindowState = ppWindowMaximized

Set DataRange = ThisWorkbook.Sheets(1).Range("A1:B5") 'change this cell range for your own data range

For Each DataRow In DataRange.Rows
   
    Set Sld = PAplication.ActivePresentation.Slides.AddSlide(PAplication.ActivePresentation.Slides.Count + 1, PAplication.ActivePresentation.SlideMaster.CustomLayouts(1))
    'Add textbox from column B
        Sld.Shapes(1).TextFrame.TextRange.Text = DataRow.Cells(1, 2)
        Sld.Shapes(1).TextFrame.AutoSize = ppAutoSizeShapeToFitText
        Sld.Shapes(1).Top = 0
       
    'Add picture from column A
    Set oShape = Sld.Shapes.AddPicture(DataRow.Cells(1, 1).Value, msoFalse, msoTrue, 1, 1, -1, -1) '(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
   
    'Size Picture, change this as your own preferences
    Set oPicture = Sld.Shapes(Sld.Shapes.Count)
        oPicture.ScaleHeight 1, msoTrue
        oPicture.ScaleWidth 1, msoTrue
        oPicture.LockAspectRatio = True
        oPicture.Width = 300 '300 is arbitrary
 
   'Center picture, change this as your own preferences
    With PAplication.ActivePresentation.PageSetup
        oPicture.Left = (.SlideWidth \ 2) - (oPicture.Width \ 2)
        oPicture.Top = (.SlideHeight \ 2) - (oPicture.Height \ 2)
    End With
   
Next DataRow
   
End Sub

From your developer, VBA, Tools -> Reference, please tick "Microsoft PowerPoint Object Library", like below:

Open readily any powerpoint, and run this macro from your excel.
Hope this can help.
Thanks