[Insane] Scaleheight & scalewidth

[El Effe]

Hi all,

I turning crazy on a macro that used to work absolutely fine on PPT 2007. I haven't changed the code whatsoever, and since I upgraded to PPT2010, it does not work anymore.
It inserts pictures from a folder onto 1 slide. It still does, but the picture ration is not preserved. On debugging, it appears that it's the shape.scaleheight and shape.scalewidth methods which do not work (whether it be in this macro or another, it's still the case!).
This is *%§$# frustrating!!!
Has anyone had this issue? I searched on the web but could not find any indication as to what the problem may be...
I hope someone can help me. I have tons of pics to insert...

Here is the code:

Sub AllPicsOnOneSlide()

Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
Dim iCounter As Integer

strPath = "C:\Mypath\"
strFileSpec = "*.jpg"

strTemp = Dir(strPath & strFileSpec)
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)

iCounter = 0

Do While strTemp <> ""

If iCounter > 0 Then
ActivePresentation.Slides(oSld.SlideNumber).TimeLine.MainSequence.AddEffect (oPic, msoAnimEffectAppear, , msoAnimTriggerOnPageClick).Exit = msoTrue
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=100, _
Height:=100)
ActivePresentation.Slides(oSld.SlideNumber).TimeLine.MainSequence.AddEffect (oPic, msoAnimEffectAppear, , msoAnimTriggerWithPrevious).Exit = msoFalse
Else
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=100, _
Height:=100)
End If

With oPic
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
.LockAspectRatio = msoTrue
.Width = ActivePresentation.PageSetup.SlideWidth

If .Height > ActivePresentation.PageSetup.SlideHeight Then
.Height = ActivePresentation.PageSetup.SlideHeight
End If

.Top = (ActivePresentation.PageSetup.SlideHeight - .Height) / 2
.Left = (ActivePresentation.PageSetup.SlideWidth - .Width) / 2

End With

iCounter = iCounter + 1
strTemp = Dir

Loop


End Sub


Thanks very much in advance

El Effe

[El Effe]

An update:

In fact, when I insert a picture manually, through the ribbon (Insert/picture), the ratio of the inserted picture is not preserved either! The picture is inserted with the format of the slide and I can't reset its ratio by any means!!!
I think this is where the problem lies, but I am no wiser as to how I can manage it or why it happens...
I can't find any info on the web. I cannot be the only one having this issue...

Any idea, anyone?

Thx in advance

El Effe

[dougbert]

DELETED see below

[dougbert]

Hi El,

I know just how *%§$# frustrating this can be. Please read some the posts in a thread (http://www.vbaexpress.com/forum/showthread.php?t=38352) to which I, among others, posted some ideas on this topic. Maybe you'll find another way to approach this problem.

One suggestion might be to leave your .LocAspectRatio as msoTrue. Then, just use .Height (instead of .ScaleHeight, etc.), along with .Top and .Right to place the upper right-hand corner of the photo whereever you'd like the photo to appear on each slide. The locked aspect ratio will take care of the picture size, adjust .Height as necessary to get just the right size for you photos. Use either .Height OR .Width; your preference. Don't use both at the same time.

Or, just try "commenting out" both the lines with .ScaleHeight and .ScaleWidth out and run the macro to see if that works better for you.

[John Wilson]

Arguably it should never have worked in 2007.

If you set the width and height to be 100 what should the scalewidth and height be??

Anyway maybe this would work for you.

Sub AllPicsOnOneSlide()

Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
Dim iCounter As Integer

strPath = "C:\MyPath\"
strFileSpec = "*.jpg"

strTemp = Dir(strPath & strFileSpec)
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)

iCounter = 0

Do While strTemp <> ""

If iCounter > 0 Then
ActivePresentation.Slides(oSld.SlideNumber).TimeLine.MainSequence.AddEffect (oPic, msoAnimEffectAppear, , msoAnimTriggerOnPageClick).Exit = msoTrue
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=msoTrue, _
Height:=msoTrue)
ActivePresentation.Slides(oSld.SlideNumber).TimeLine.MainSequence.AddEffect (oPic, msoAnimEffectAppear, , msoAnimTriggerWithPrevious).Exit = msoFalse
Else
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=msoTrue, _
Height:=msoTrue)
End If

With oPic
.LockAspectRatio = msoTrue
.Width = ActivePresentation.PageSetup.SlideWidth

If .Height > ActivePresentation.PageSetup.SlideHeight Then
.Height = ActivePresentation.PageSetup.SlideHeight
End If

.Top = (ActivePresentation.PageSetup.SlideHeight - .Height) / 2
.Left = (ActivePresentation.PageSetup.SlideWidth - .Width) / 2

End With

iCounter = iCounter + 1
strTemp = Dir

Loop


End Sub

[El Effe]

Thank you so much John and Dougbert for taking the time to reply!!

Your solution is working, John! That's perfect.
I still have not figured out why my code used to work in PPT 2007 and not in PPT 2010...

Anyway, thanks again.
Sorry for the delay in coming back to the forum to check your replies!

El Effe

[John Wilson]

When you use Addpicture the width and height are OPTIONAL. If you do not specify it will default to the actual width / height. You should not set it to an arbitary value such as 100. In some versions scaleheight will correct this but in others it will take 100 to be the original scaleheight and scalewidth. (understandably as you have told PowerPoint that!) Setting the value to msoTrue or -1 ensures that the original scaleheight/width are used.