Molienergy
Programmer
I have a Powerpoint slide that shows a floor layout.
There are several shape objects which link to a picture of that area. When I activate the shape in a slide show the picture opens in Microsoft Picture viewer at full scale.
What I'd like to do is have the picture open in the middle of the screen to a predetermined size and then when I click on the image it disappears. I could then select another shape and have a diferent picture display according to the shape.
I have tried to code this in VBA but can't seem to get the object link to appear. Any help would be appreciated.
Sub PopupNew1(osh As Shape)
' Use the formatting dialog, Web Text tab to enter your picture path
' On playback, a popup will open the picture to scale defined then disappear
' when you click the popup again
Dim oPopupNew As Shape
Dim oSl As Slide
Dim dOffset As Double
Dim TempImage As String
Set oSl = osh.Parent
TempImage = "F:\molidoc\dept\Logistics\Scheduling Implementation\Pictures\coater.JPEG"
Set oPopupNew = oSl.Shapes.AddPicture(TempImage, msoFalse, msoTrue, 200, 100, 400, 300)
With oPopupNew
.ActionSettings(ppMouseClick).Run = "Delete"
End With
ActivePresentation.SlideShowWindow.View.GotoSlide (oSl.SlideIndex)
End Sub
There are several shape objects which link to a picture of that area. When I activate the shape in a slide show the picture opens in Microsoft Picture viewer at full scale.
What I'd like to do is have the picture open in the middle of the screen to a predetermined size and then when I click on the image it disappears. I could then select another shape and have a diferent picture display according to the shape.
I have tried to code this in VBA but can't seem to get the object link to appear. Any help would be appreciated.
Sub PopupNew1(osh As Shape)
' Use the formatting dialog, Web Text tab to enter your picture path
' On playback, a popup will open the picture to scale defined then disappear
' when you click the popup again
Dim oPopupNew As Shape
Dim oSl As Slide
Dim dOffset As Double
Dim TempImage As String
Set oSl = osh.Parent
TempImage = "F:\molidoc\dept\Logistics\Scheduling Implementation\Pictures\coater.JPEG"
Set oPopupNew = oSl.Shapes.AddPicture(TempImage, msoFalse, msoTrue, 200, 100, 400, 300)
With oPopupNew
.ActionSettings(ppMouseClick).Run = "Delete"
End With
ActivePresentation.SlideShowWindow.View.GotoSlide (oSl.SlideIndex)
End Sub