VBA Help

Mnewton911

New member
Local time
Today, 11:04
Joined
Sep 14, 2010
Messages
8
I am building a macro to write a bunch of information to powerpoint slides an attempt to automate the process.

I borrowed some code from a friend's application which simply posted pictures of text ranges.

I was wondering if this formula could be altered given the format of the selection to instead of pasting the excel range as an image - but a linked table so that i do not have to re-run the whole macro each time we need to make a formatting change.

Here is the code as listed below.
Code:
Public Function copy_range(sheet, rowStart, columnStart, row_count, columnCount, slide, aheight, awidth, atop, aleft)
 
Sheets(sheet).Select
 
Cells(rowStart, columnStart).Resize(row_count, columnCount).Select
' Make sure a range is selected
 
If Not TypeName(Selection) = "Range" Then
   MsgBox "Please select a worksheet range and try again.", vbExclamation, _
   "No Range Selected"
Else
   ' Reference existing instance of PowerPoint
   Set PPApp = GetObject(, "Powerpoint.Application")
   ' Reference active presentation
   Set PPPres = PPApp.ActivePresentation
 
   PPApp.ActiveWindow.ViewType = ppViewSlide
 
   PPApp.ActiveWindow.View.GotoSlide (slide)
 
   ' Reference active slide
   Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
 
   ' Copy the range as a picture
   Selection.CopyPicture Appearance:=xlScreen, _
   Format:=xlBitmap
 
   ' Paste the range
   PPSlide.Shapes.Paste.Select
   
   Dim sr As PowerPoint.ShapeRange
   Set sr = PPApp.ActiveWindow.Selection.ShapeRange
 
   ' Resize:
   sr.Width = awidth
   sr.Height = aheight
 
      If sr.Width > 700 Then
         sr.Width = 700
      End If
 
      If sr.Height > 420 Then
         sr.Height = 420
      End If
 
   ' Realign:
   sr.Align msoAlignCenters, True
   sr.Align msoAlignMiddles, True
   sr.Top = atop
 
      If aleft <> 0 Then
         sr.Left = aleft
      End If
 
   ' Clean up
   Set PPSlide = Nothing
   Set PPPres = Nothing
   Set PPApp = Nothing
End If
End Function
Any help into this would be amazing.
Thank You!
- Matt
 
Last edited by a moderator:

Users who are viewing this thread

Back
Top Bottom