Inserting An Excel Range Into A PPT Slide

[Bob Phillips]

Wonder if anyone can tell me a way to overcome a problem I have.

I am creating a PPT slidedeck from Excel using automation.

In some instances I am inserting an Excel range as an image into a slide. In
itself this works fine, and I scale the image so that it fits nicely, but
....

When I have a largeish range, even though I am passing the whole range, the
data being pasted in is being truncated, before I scale it. I can reduce the
column size in Excel and it works fine, but I would rather avoid this as in
certain instances it can squeeze the data and the cell shows the dreaded
####, which then appears on the slide.

Does anyone have a better way of avoiding this problem?

For what it is worth this is my code for inserting the range


'---------------------------------------------------------------------------
Public Function InsertRange(ByRef SourceData As Range, _
ByRef Slidename As String, _
ByVal Left As Long, _
Optional ByVal Top As Long, _
Optional ByVal Width As Long, _
Optional ByVal Height As Long) As Boolean
'---------------------------------------------------------------------------
Dim mpShape As Object
Dim mpRetries As Long

Const mpProcedure As String = "InsertRange"

InsertRange = True

On Error Resume Next
Application.DisplayAlerts = False
SourceData.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
If Err.Number = 0 Then

Application.DisplayAlerts = True
Else

Call LogError(99999, mpProcedure, _
"CopyPicture in screen mode failed; changing to using
printer mode", _
False)

Do

On Error Resume Next

Application.DisplayAlerts = False

DoEvents
Err.Number = 0
SourceData.CopyPicture Appearance:=xlPrinter, _
Format:=xlPicture

mpRetries = mpRetries + 1
Application.DisplayAlerts = True
If mpRetries >= 9 Then

On Error GoTo InsertRange_Error
Err.Raise mgCopyPicture
End If
Loop Until Err.Number = 0

On Error GoTo 0
End If

Set mpShape = ActivePresentation.Slides(Slidename).Shapes.Paste
If Top <> 0 Then

With mpShape 'mPPT.ActiveWindow.Selection.ShapeRange
.Top = Top
.Left = Left
End With
Else

With mpShape 'mPPT.ActiveWindow.Selection.ShapeRange
.Align msoAlignMiddles, True
.Left = Left
End With
End If

If Width <> 0 Then mpShape.Width = Width
If Height <> 0 Then mpShape.Height = Height

End Function

TIA

Bob