tommy1234
12-31-2011, 09:52 AM
Hi
I wrote a code in vba for excel 2010 which copy an area from worksheet to power point slide.
the problem is that when users run the code on office 2007 they get error in one of the modules.
How can i fix it, without interrupting them with the automatically error popup from the excel.
Thanks
ub copy_ppt()
'copy the dashboard to a new ppt slide with positioning
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim lines As String, lines1 As String, lines2 As String
' Reference instance of PowerPoint
On Error Resume Next
' Check whether PowerPoint is running
Set PPApp = GetObject(, "PowerPoint.Application")
If PPApp Is Nothing Then
' PowerPoint is not running, create new instance
Set PPApp = CreateObject("PowerPoint.Application")
' For automation to work, PowerPoint must be visible
PPApp.Visible = True
End If
On Error GoTo 0
' Reference presentation and slide
On Error Resume Next
If PPApp.Windows.Count > 0 Then
' There is at least one presentation
' Use existing presentation
Set PPPres = PPApp.ActivePresentation
' Use active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
Else
' There are no presentations
' Create new presentation
Set PPPres = PPApp.Presentations.Add
' Add first slide
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
PPSlide.Shapes(1).TextFrame.textRange = "Project Status" & " " & Format(Worksheets("pivot") _
.Range("b321"), "mm/yyyy")
End If
On Error GoTo 0
' Some PowerPoint actions work best in normal slide view
PPApp.ActiveWindow.ViewType = ppViewSlide
Sheets("Status").Select
Range("e1:r39").Select
' Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
' Paste the range with positioning
With PPSlide.Shapes.Paste
.Top = 60
.Left = 60
.Width = 600
.Height = 465
End With
Set PPSlide = PPPres.Slides.Add(2, ppLayoutTitleOnly)
PPSlide.Shapes(1).TextFrame.textRange = "Point of interest" & " " & Format(Worksheets("pivot") _
.Range("b321"), "mm/yyyy")
' Some PowerPoint actions work best in normal slide view
PPApp.ActiveWindow.ViewType = ppViewSlide
Sheets("Status").Select
Range("e40:r72").Select
' Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
' Paste the range with positioning
With PPSlide.Shapes.Paste
.Top = 80
.Left = 20
.Width = 600
.Height = 420
End With
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
Cells(1, 18).Select
End Sub
I wrote a code in vba for excel 2010 which copy an area from worksheet to power point slide.
the problem is that when users run the code on office 2007 they get error in one of the modules.
How can i fix it, without interrupting them with the automatically error popup from the excel.
Thanks
ub copy_ppt()
'copy the dashboard to a new ppt slide with positioning
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim lines As String, lines1 As String, lines2 As String
' Reference instance of PowerPoint
On Error Resume Next
' Check whether PowerPoint is running
Set PPApp = GetObject(, "PowerPoint.Application")
If PPApp Is Nothing Then
' PowerPoint is not running, create new instance
Set PPApp = CreateObject("PowerPoint.Application")
' For automation to work, PowerPoint must be visible
PPApp.Visible = True
End If
On Error GoTo 0
' Reference presentation and slide
On Error Resume Next
If PPApp.Windows.Count > 0 Then
' There is at least one presentation
' Use existing presentation
Set PPPres = PPApp.ActivePresentation
' Use active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
Else
' There are no presentations
' Create new presentation
Set PPPres = PPApp.Presentations.Add
' Add first slide
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
PPSlide.Shapes(1).TextFrame.textRange = "Project Status" & " " & Format(Worksheets("pivot") _
.Range("b321"), "mm/yyyy")
End If
On Error GoTo 0
' Some PowerPoint actions work best in normal slide view
PPApp.ActiveWindow.ViewType = ppViewSlide
Sheets("Status").Select
Range("e1:r39").Select
' Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
' Paste the range with positioning
With PPSlide.Shapes.Paste
.Top = 60
.Left = 60
.Width = 600
.Height = 465
End With
Set PPSlide = PPPres.Slides.Add(2, ppLayoutTitleOnly)
PPSlide.Shapes(1).TextFrame.textRange = "Point of interest" & " " & Format(Worksheets("pivot") _
.Range("b321"), "mm/yyyy")
' Some PowerPoint actions work best in normal slide view
PPApp.ActiveWindow.ViewType = ppViewSlide
Sheets("Status").Select
Range("e40:r72").Select
' Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
' Paste the range with positioning
With PPSlide.Shapes.Paste
.Top = 80
.Left = 20
.Width = 600
.Height = 420
End With
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
Cells(1, 18).Select
End Sub