Hi!
i'm a novice to VBA and i'm really struggling!
I have an excel file with a wide variety of charts and tables that need:
- copying from excel to powerpoint but keeping the source formatting
- each table / chart has a unique position in these slide and need adjusting. For example table 1 from slide dash needs to be set to the below position:
With mypres.PageSetup
shp.LockAspectRatio = True
shp.Width = 600
shp.Height = 500
shp.Left = 15
- unfortunately each slide has a slightly unique positioning so its not an apply all situation.
I've tried the below codes but i get errors on both and i don't know what to do next.
thanks!
Sub PasteMultipleSlides()
Dim mypres As Object, ppapp As Object, shp As Object, sa, ra, x%, ns%, i%
Set ppapp = GetObject(Class:="PowerPoint.Application")
Err.Clear
If ppapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
ppapp.ActiveWindow.Panes(2).Activate
Set mypres = ppapp.ActivePresentation
sa = Array(3) 'powerpoint slide Dashboard slide 4
ra = Array(Sheets("Dashboard Table v2").Range("A2:S20"))
For x = LBound(sa) To UBound(sa)
ra(x).copy
mypres.Windows(1).View.GotoSlide sa(x)
ns = mypres.Slides(sa(x)).Shapes.Count
ppapp.CommandBars.ExecuteMso ("PasteSourceFormatting")
DoEvents
For i = 1 To mypres.Slides(sa(x)).Shapes.Count
Next
Set shp = mypres.Slides(sa(x)).Shapes(ns + 1)
With mypres.PageSetup
shp.LockAspectRatio = True
shp.Width = 600
shp.Height = 500
shp.Left = 15
shp.Top = 20
End With
Next
Application.CutCopyMode = False
and
Sub insertthegraph()
Dim mypres As Object, ppapp As Object, shp As Object, sa, ra, x%, ns%, i%
Set ppapp = GetObject(Class:="PowerPoint.Application")
Err.Clear
If ppapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
ppapp.ActiveWindow.Panes(2).Activate
Set mypres = ppapp.ActivePresentation
sa = Array(4) 'powerpoint slide Dashboard slide 4
ra = Array(Sheets("Dashboard Table v2").ChartObjects("Chart 5"))
For x = LBound(sa) To UBound(sa)
ra(x).copy
mypres.Windows(1).View.GotoSlide sa(x)
ns = mypres.Slides(sa(x)).Shapes.Count
ppapp.CommandBars.ExecuteMso ("PasteSourceFormatting")
DoEvents
DoEvents
For i = 1 To mypres.Slides(sa(x)).Shapes.Count
Next
Set shp = mypres.Slides(sa(x)).ChartObjects("Chart 5")
With mypres.PageSetup
shp.Width = 100
shp.Height = 100
shp.Left = 100
shp.Top = 100
End With
Next
Application.CutCopyMode = False
End Sub
End Sub
i'm a novice to VBA and i'm really struggling!
I have an excel file with a wide variety of charts and tables that need:
- copying from excel to powerpoint but keeping the source formatting
- each table / chart has a unique position in these slide and need adjusting. For example table 1 from slide dash needs to be set to the below position:
With mypres.PageSetup
shp.LockAspectRatio = True
shp.Width = 600
shp.Height = 500
shp.Left = 15
- unfortunately each slide has a slightly unique positioning so its not an apply all situation.
I've tried the below codes but i get errors on both and i don't know what to do next.
thanks!
Sub PasteMultipleSlides()
Dim mypres As Object, ppapp As Object, shp As Object, sa, ra, x%, ns%, i%
Set ppapp = GetObject(Class:="PowerPoint.Application")
Err.Clear
If ppapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
ppapp.ActiveWindow.Panes(2).Activate
Set mypres = ppapp.ActivePresentation
sa = Array(3) 'powerpoint slide Dashboard slide 4
ra = Array(Sheets("Dashboard Table v2").Range("A2:S20"))
For x = LBound(sa) To UBound(sa)
ra(x).copy
mypres.Windows(1).View.GotoSlide sa(x)
ns = mypres.Slides(sa(x)).Shapes.Count
ppapp.CommandBars.ExecuteMso ("PasteSourceFormatting")
DoEvents
For i = 1 To mypres.Slides(sa(x)).Shapes.Count
Next
Set shp = mypres.Slides(sa(x)).Shapes(ns + 1)
With mypres.PageSetup
shp.LockAspectRatio = True
shp.Width = 600
shp.Height = 500
shp.Left = 15
shp.Top = 20
End With
Next
Application.CutCopyMode = False
and
Sub insertthegraph()
Dim mypres As Object, ppapp As Object, shp As Object, sa, ra, x%, ns%, i%
Set ppapp = GetObject(Class:="PowerPoint.Application")
Err.Clear
If ppapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
ppapp.ActiveWindow.Panes(2).Activate
Set mypres = ppapp.ActivePresentation
sa = Array(4) 'powerpoint slide Dashboard slide 4
ra = Array(Sheets("Dashboard Table v2").ChartObjects("Chart 5"))
For x = LBound(sa) To UBound(sa)
ra(x).copy
mypres.Windows(1).View.GotoSlide sa(x)
ns = mypres.Slides(sa(x)).Shapes.Count
ppapp.CommandBars.ExecuteMso ("PasteSourceFormatting")
DoEvents
DoEvents
For i = 1 To mypres.Slides(sa(x)).Shapes.Count
Next
Set shp = mypres.Slides(sa(x)).ChartObjects("Chart 5")
With mypres.PageSetup
shp.Width = 100
shp.Height = 100
shp.Left = 100
shp.Top = 100
End With
Next
Application.CutCopyMode = False
End Sub
End Sub