Advice & Error Trapping

[michael.beckinsale]

Hi All,

I have 'borrowed' some of code examples from other posters here to
export ranges to powerpoint.

The code has been modified to loop through each sheet and export the
print_area as XLbitmaps to individual slides in Powerpoint (PP), make
the bitmap fit the slide, save the file etc. All is working OK but l
have a few questions as follows:

1) How can l trap the error that occurs when saving a file that has
the same name as one already open in PP? I expected the standard
system generated warning "A file with that name is already
open.......etc)

2) This file is to be distributed around the company. Everybody is on
the same version of Excel. Will the reference to 'Microsoft Powerpoint
11.0 Object Library' remain intact?

3) If the reference to PP does not remain intact / is not robust then
should l change to late binding? Not sure exactly what this or what
code changes are necessary.

4) I have used xlBitmap rather xlPicture as the picture type as it
seems to give a more consistent look in PP. Are there any drawbacks to
this? Can pictures be 'sharpened'?

All contributions gratefully received

Please beware wordwrap.......many comments!

Sub PrintAreaToNewPowerpoint()

'REMEMBER: Set VBE reference to Microsoft PowerPoint 11.0 Object
'OUTPUT : xlBitmap appears to give more consistent quality, xlPicture
is the alternative
'SAVE AS : Error trapping required when existing file is open in
Powerpoint

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PPShape As PowerPoint.Shape
Dim PPFileName As String
Dim CurrentTitle As String
Dim SlideCount As Long
Dim Filename As String
Dim PicRange As String
Dim NewFilename As String
Dim PPActive As String

' Activate Powerpoint or create new instance of Powerpoint
On Error Resume Next
Set PPApp = GetObject(, "PowerPoint.Application")
PPActive = "Yes"
If PPApp Is Nothing Then
Set PPApp = CreateObject("PowerPoint.Application")
'PPApp.Visible = True
PPActive = "No"
End If
On Error GoTo 0

' Create new presentation
Set PPPres = PPApp.Presentations.Add

' Set variables
CurrentTitle = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
PPFileName = ThisWorkbook.Path & "\" & CurrentTitle & ".ppt"
SlideCount = PPPres.Slides.Count
Filename = ThisWorkbook.Name

'Loop through each sheet
For Each Sht1 In Workbooks(Filename).Worksheets
PicRange = ""
On Error Resume Next
PicRange = Sht1.Range("Print_Area").Address
On Error GoTo 0
If PicRange = "" Then
MsgBox ("The worksheet '" & Sht1.Name & "' has no print
area set and will not be created in Powerpoint")
Else
Sht1.Range("Print_Area").CopyPicture xlScreen, xlBitmap
' Paste picture into PP
Set PPSlide = PPPres.Slides.Add(SlideCount + 1,
ppLayoutBlank)
With PPSlide
.Shapes.Paste
'//....add code to size to fit
Set PPShape = .Shapes(.Shapes.Count)
PPwidth = PPShape.Width
PPheight = PPShape.Height
If PPwidth < 680 And PPheight < 584 Then
PPwidth = PPwidth
PPheight = PPheight
Else
PPwidth = 680 / PPwidth
PPheight = 584 / PPheight
If PPwidth < PPheight Then
PPsize = PPwidth
PPShape.ScaleWidth PPsize, msoFalse,
msoScaleFromTopLeft
Else
If PPheight < PPwidth Then
PPsize = PPheight
PPShape.ScaleHeight PPsize, msoFalse,
msoScaleFromTopLeft
End If
End If
End If
PPShape.Left = 22
PPShape.Top = 22
'//....end of added code
End With
SlideCount = SlideCount + 1
End If
Next Sht1

' Save PP file in same directory & with same name as source file
or choice of name
With PPPres
NewFilename = InputBox("The Powerpoint file will be saved as :
" _
& vbCrLf _
& vbCrLf _
& CurrentTitle _
& vbCrLf _
& vbCrLf _
& "Please enter a new name if required.",
"Powerpoint File Information", CurrentTitle)

If NewFilename = "" Then
MsgBox ("The Powerpoint file has not been saved.")
If PPActive = "No" Then
.Close
End If
Else
NewFilename = ThisWorkbook.Path & "\" & NewFilename &
".ppt"
.SaveAs NewFilename
If PPActive = "No" Then
.Close
End If
End If
End With

' Tidy up & exit
If PPActive = "No" Then
PPApp.Quit
End If
Set PPApp = Nothing
Set PPPres = Nothing
Set PPSlide = Nothing
Set PPShape = Nothing

End Sub

Regards

Michael

 

[Peter T]

Comments in-line

Hi All,

I have 'borrowed' some of code examples from other posters here to
export ranges to powerpoint.

The code has been modified to loop through each sheet and export the
print_area as XLbitmaps to individual slides in Powerpoint (PP), make
the bitmap fit the slide, save the file etc. All is working OK but l
have a few questions as follows:

1) How can l trap the error that occurs when saving a file that has
the same name as one already open in PP? I expected the standard
system generated warning "A file with that name is already
open.......etc)

One way -
Dim s as string
On error resume next
s = PPApp.Presentations(NewFilename).Name
On error goto 0
If Len(s) Then
' NewFileName is same as an open doc

Of course this doesn't test for the possibility of a closed same name file
in same location.

2) This file is to be distributed around the company. Everybody is on
the same version of Excel. Will the reference to 'Microsoft Powerpoint
11.0 Object Library' remain intact?

In theory yes, until someone takes it home, saves it on their earlier
version, then brings it back to the office! If in doubt convert to Late
Binding and remove the reference.

3) If the reference to PP does not remain intact / is not robust then
should l change to late binding? Not sure exactly what this or what
code changes are necessary.

To convert, change all PP type declarations to "As Object" and change any
named constants to their intrinsic values (not that you have any in your
code).

4) I have used xlBitmap rather xlPicture as the picture type as it
seems to give a more consistent look in PP. Are there any drawbacks to
this? Can pictures be 'sharpened'?

If the image in PP will be the same size as original the bitmap should be
perfect, otherwise experiement with both arguments in CopyPicture.

In passing -
Set PPApp = Nothing
Set PPPres = Nothing
Set PPSlide = Nothing
Set PPShape = Nothing

Always release object references in the reverse order to which they were
created. However no need to bother with these at all as they will
automatically go out of scope when the sub ends.

Regards,
Peter T

 

[Jim Thomlinson]

Lots of questions here. In general when it comes to errors the first line of
defense is to avoid creating the error in the first place. That is the case
here for the most part...

Question 1 - avoid overwriting. If you use the Dir function you will be able
to determine if a file by that name already exists. If you do this prior to
saving then you will know if you can just save directly or if you need to get
a bit more fancy to avoid overwriting.

Question 2&3 - if you can not guarantee the references on the end user
computers then you will want to use late binding. In your case that is almost
certainly the route you will want to follow. The change is realtively easy.

Change your Powerpoint objects to just plain objects. I notice that you are
already using the create object method so there is no change required there.
The final step is to change any constants from their constant to their
underlying value. For example xlUp is a constant that only mkaes sense if you
have a reference to XL. Without that reference you need to use the underlying
value. To get teh value with the reference still in place just use...

Debug.Print xlUp
or a message box.

As for question 4 I have no idea. Best of luck on that one...

 

[michael.beckinsale]

Hi All,

Thank you for your advice & guidance.

As l suspected you have confirmed that l really need to go the late
binding route. I dont know much about binding in general and will
repost as aseperate subject if l have any questions / problems.

I will investigate the DIR method as an error trapping solution.

Again many thanks

Michael