VBA - Powerpoint resizing a shape

mmohon

New Member
Joined
Nov 19, 2009
Messages
38
I have some code that pastes in an excel chart.
Once pasted in, I want to size and position in. I have the size and position I pull in from some cells.

The positioning is spot on, but the sizing makes the chart tiny tiny, not even visible. I can only select it and re size it. What am I doing wrong?

Code:
Sub xls2ppt()

   Dim ThisFile As String
   Dim PPTFile As String
   Dim PPApp As PowerPoint.Application
   Dim PPPres As PowerPoint.Presentation

    ThisFile = ActiveWorkbook.FullName
    PPTFile = Application.GetOpenFilename
    Set PPApp = CreateObject("Powerpoint.Application")
    PPApp.Visible = True
    PPApp.presentations.Open Filename:=PPTFile
    Set PPPres = PPApp.ActivePresentation

    Application.CutCopyMode = False
    
   Worksheets("Setup").Select
   ObjectName = Cells(7, 2).Value
   ObjectType = Cells(7, 3).Value
   ObjectLoc = Cells(7, 4).Value
   pptSlide = Cells(7, 5).Value
   pptPos_Top = Cells(7, 6).Value
   pptPos_Left = Cells(7, 7).Value
   pptSize_Width = Cells(7, 8).Value
   pptSize_Height = Cells(7, 9).Value
   
   Sheets(ObjectLoc).Select
   Select Case ObjectType
    Case "Chart"
        ActiveSheet.ChartObjects(ObjectName).Select
    Case "Range"
        ActiveSheet.Range(ObjectName).Select
   End Select
   Selection.CopyPicture
   
   PPApp.Visible = True
   PPApp.ActiveWindow.ViewType = 1
   PPPres.slides(pptSlide).Select
   PPApp.ActiveWindow.View.Paste
    
    Set oshp = PPApp.ActiveWindow.Selection.ShapeRange(1)
    With oshp
        .LockAspectRatio = False
        .Height = pptPos_Height * 72
        .Width = pptPos_Width * 72
        .Left = pptPos_Left * 72
        .Top = pptPos_Top * 72
    End With
 
   Worksheets("Setup").Select
   End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Forum statistics

Threads
1,225,611
Messages
6,185,996
Members
453,334
Latest member
Prakash Jha

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top