Export especific Cells from different sheets to slides in PPT

[KYCH]

Hi,

It took me a while surfing several days, and checking some codes, I have 0 experience, this is why i want to share it with others and thanks for all the experts that help us.

Here is the code that enables you copy especific cells ranges from the same, or different sheets to slides (in the same order that is written in the code). As well alignment ** the exported images in PPT slide. I have modified the original code from 'By Christos Samaras, 'http://www.myengineeringworld'. Also available in that web, export excel table to tables in PPT. However the script hereunder has been changed to copy cells and paste them as images in PPT. As Usual needs to be activated Micros**t Powerpoint.

Option Explicit

    'Both subs require a reference to Micros**t PowerPoint xx.x Object Library.
    'where xx.x is your **fice version (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010).

    'Declaring the necessary Power Point variables, whick are used in both subs.
    Dim pptApp          As PowerPoint.Application
    Dim pptPres         As PowerPoint.Presentation
    Dim pptSlide        As PowerPoint.Slide
    Dim pptSlideCount   As Integer

Sub TablesToPowerPoint()
    
    'Exports the range A1:C5 from each sheet to a new Power Point
    'presentation as table. Each range is copied to a new slide.
        
    'By Christos Samaras http://www.myengineeringworld.net
   'Modified by Karla Coello

        
    Dim ws As Worksheet
          
    'Open Power Point and create a new presentation.
    Set pptApp = New PowerPoint.Application
    Set pptPres = pptApp.Presentations.Add
    
    'Show the Power Point application.
    pptApp.Visible = True

    'Transfer the data from the selected range from the same or different sheets,
    'to the Power Point presentation.
    'the order specified per each line will appear in consecutive slide in ppt

    Sheet1.Activate
    ExcelTableToPowerPoint (ActiveSheet.Range("B1:D17"))
    Sheet4.Activate
    ExcelTableToPowerPoint (ActiveSheet.Range("B8:W25"))
    Sheet2.Activate
    ExcelTableToPowerPoint (ActiveSheet.Range("B7:H19"))
    Sheet2.Activate
    ExcelTableToPowerPoint (ActiveSheet.Range("B20:H29"))
    Sheet2.Activate
    ExcelTableToPowerPoint (ActiveSheet.Range("B30:H50"))
    
    'Return the "focus" to the frist sheet.
    ActiveWorkbook.Worksheets(1).Activate
    
    'Infrom the user that the macro finished.
    MsgBox "The report was sent to PPT!", vbInformation, "Done"
    
End Sub

Private Sub ExcelTableToPowerPoint(xlRange As Range)

'Copies an Excel Table as picture to Power Point.

'By Christos Samaras
'http://www.myengineeringworld....

'Check if the range is valid.
If Application.Intersect(xlRange, ActiveSheet.Range("A1:XFD1048576")) Is Nothing Then
MsgBox "Sorry, the range you selected is not valid!", vbCritical, "Invalid range"
Exit Sub
End If


'Copy the range.
xlRange.CopyPicture

'Count the slides and add a new one after the last slide.
pptSlideCount = pptPres.Slides.Count
Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)

'Paste the picture and adjust its position
With pptSlide.Shapes.Paste
.Align msoAlignCenters, True
.Top = 50
.Left = 10
.Width = 700

End With


End Sub