VBA to VB.Net code Help

  • Thread starter Thread starter Naro25
  • Start date Start date
N

Naro25

Hello all,

I am an absolute beginner to VB and trying to write a one off program. I
wonder could someone please help me with the following simple code. My issue
is I wrote a working code to automate an animation within powerpoint i.e VBA
and need to transfer it to a user form in VB2008 so that a simple button
click will open ppt and perform the following actions.
The code to open powerpoint with a blank side and apply the ppt object
library isnt a problem, just a continuous list of error in below code about
activewindow and msoTrue/False not defined.

Any help with this matter would be extremely appreciated!

Sub ImportPicRenameLocateAnimate2()

Dim oSlide As Slide
Dim oPicture As shape
Dim shp1 As shape
Dim sResponse As String
Dim interEffect As Effect


ActiveWindow.View.GotoSlide 1

Set oSlide = ActiveWindow.Presentation.Slides(1)
Set oPicture = oSlide.Shapes.AddPicture("X.JPG", _
msoFalse, msoTrue, 1, 1, 1, 1)
' Now scale the picture to full size, with "Relative to original
' picture size" set to true for both height and width.
oPicture.ScaleHeight 1, msoTrue
oPicture.ScaleWidth 1, msoTrue

Set shp1 =
ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRectangle, 104.88,
326.75, 198.38, 102#)
With shp1
.Name = "Zone1"
.Fill.Transparency = 1#
.Line.Visible = msoFalse
.Height = 141.75
.Width = 141.75
End With


With ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add(1)
Set interEffect = .AddEffect(shp1, msoAnimEffectFly, _
trigger:=msoAnimTriggerOnShapeClick)
interEffect.shape = oPicture

With interEffect
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 0.5
End With
End With


With ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add(1)
Set interEffect = .AddEffect(shp1, msoAnimEffectFly, _
trigger:=msoAnimTriggerOnShapeClick)
interEffect.shape = oPicture

With interEffect
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 0.5
.Exit = msoTrue
End With
End With

With ActivePresentation.PageSetup
oPicture.Select
End With

'Rename image'
With ActiveWindow.Selection.ShapeRange(1)
sResponse = InputBox("new name ...", "Rename Shape", .Name)
Select Case sResponse
' blank names not allowed
Case Is = ""
Exit Sub
' no change?
Case Is = .Name
Exit Sub
Case Else
On Error Resume Next
.Name = sResponse
If Err.Number <> 0 Then
MsgBox "Unable to rename this shape"
End If
End Select
End With

With ActivePresentation.Slides(1).Shapes("X")
.Top = 0
.Left = 0
.Height = 271.75
.Width = 453.38
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = ppForeground
.Line.BackColor.RGB = RGB(255, 255, 255)
End With


End Sub
 
Many thanks for your input Steve. I have the same question posted on VBforums
but can't get a response there either. IYO can you recommend the best port of
call forum for this?

Thanks.
 
Hi Steve, sorry I didn't post the open ppt segment as I didnt have an issue
with it, but here it is below. Im starting to figure some things out like
adding a image/shapes. e.g.

oPres.Slides(1).Select()
oShape =
oPres.Slides(1).Shapes.AddShape(Microsoft.Office.Core.MsoAutoShapeType.msoShapeRectangle, 100, 100, 100, 100)
With oShape
.Fill.Transparency = 1.0#
.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
.Height = 141.75
.Width = 141.75
End With

I could resolve this post if someone could simply give me an example of
adding an entry/exit effect to an object. That's really all I'm stuck on now.

Imports Office = Microsoft.Office.Core
Imports PowerPoint = Microsoft.Office.Interop.PowerPoint


Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click


Const sPic = "X.jpg"
Dim oApp As PowerPoint.Application
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oShape As PowerPoint.Shape

'Start Powerpoint and make its window visible but minimized.
oApp = New PowerPoint.Application()
oApp.Visible = True
oApp.WindowState = PowerPoint.PpWindowState.ppWindowMaximized

'Create a new presentation.
oPres =
oApp.Presentations.Add(Microsoft.Office.Core.MsoTriState.msoTrue)
oPres.SaveAs("c:\mypres.ppt")

'Build Slide #1:
'Add text to the slide, change the font and insert/position a
'picture on the first slide.
oSlide = oPres.Slides.Add(1, PowerPoint.PpSlideLayout.ppLayoutBlank)
 
Sorry, to be a bit more specific, this is exactly what I'm trying to
replicate in Vb.Net:

With ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add(1)
Set interEffect = .AddEffect(shp1, msoAnimEffectFly, _
trigger:=msoAnimTriggerOnShapeClick)
interEffect.shape = oPicture

With interEffect
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 0.5
End With
End With


With ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add(1)
Set interEffect = .AddEffect(shp1, msoAnimEffectFly, _
trigger:=msoAnimTriggerOnShapeClick)
interEffect.shape = oPicture

With interEffect
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 0.5
.Exit = msoTrue
End With
End With
 
Sorry Steve, it was a bit all over the place. In summary, this is what I've
got so far:

Imports Office = Microsoft.Office.Core
Imports PowerPoint = Microsoft.Office.Interop.PowerPoint


Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click


Const sPic = "C:\X.jpg"
Dim oApp As PowerPoint.Application
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oShape As PowerPoint.Shape

'Start Powerpoint and make its window visible but minimized.
oApp = New PowerPoint.Application()
oApp.Visible = True
oApp.WindowState = PowerPoint.PpWindowState.ppWindowMaximized

'Create a new presentation based on the specified template.
oPres =
oApp.Presentations.Add(Microsoft.Office.Core.MsoTriState.msoTrue)
oPres.SaveAs("c:\mypres.ppt")

'Build Slide #1:
'Add text to the slide, change the font and insert/position a
'picture on the first slide.
oSlide = oPres.Slides.Add(1, PowerPoint.PpSlideLayout.ppLayoutBlank)

oSlide.Shapes.AddPicture(sPic, False, True, 150, 150, 500, 350)
oSlide = Nothing

oPres.Slides(1).Select()
oShape =
oPres.Slides(1).Shapes.AddShape(Microsoft.Office.Core.MsoAutoShapeType.msoShapeRectangle, 100, 100, 100, 100)
With oShape
.Fill.Transparency = 1.0#
.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
.Height = 141.75
.Width = 141.75
End With

Ive got all this working fine now. As I mentioned, I'm just struggling with
the following code brought over from VBA to add animation effects to the
above object, with the transparent rectangle being the trigger:

With ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add(1)
interEffect = .AddEffect(oShape, msoAnimEffectFly, _
trigger:=msoAnimTriggerOnShapeClick)
interEffect.shape = sPic

With interEffect
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 0.5
End With
End With


With ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add(1)
interEffect = .AddEffect(oShape, msoAnimEffectFly, _
trigger:=msoAnimTriggerOnShapeClick)
interEffect.shape = sPic


With interEffect
.EffectParameters.Direction = msoAnimDirectionLeft
.Timing.Duration = 0.5
.Exit = msoTrue
End With
End With


The errors are as follows:
ActivePresentation not declared
intereffect not declared
msoAnimEffectFly not declared
msoAnimTriggerOnShapeClick not declared
etc
etc

Thanks so much for taking the time to help.
Regards,
Naro25
 
Hi Steve, thanks that certainly got things nudged along a bit!! I've
eliminated all errors now but getting caught up on this line:

interEffect = .AddEffect(oShape, PowerPoint.MsoAnimEffect.msoAnimEffectFly,
PowerPoint.MsoAnimTriggerType.msoAnimTriggerOnShapeClick)

It produces a warning: COMException was unhandled. Full code now is as
follows:

Imports Office = Microsoft.Office.Core
Imports PowerPoint = Microsoft.Office.Interop.PowerPoint


Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click

Dim oApp As PowerPoint.Application
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oShape As PowerPoint.Shape
Dim interEffect As PowerPoint.Effect (<g> didn't seem to work)
Dim sPic As PowerPoint.Shape

'Start Powerpoint and make its window visible but minimized.
oApp = New PowerPoint.Application()
oApp.Visible = True
oApp.WindowState = PowerPoint.PpWindowState.ppWindowMaximized

'Create a new presentation based on the specified template.
oPres =
oApp.Presentations.Add(Microsoft.Office.Core.MsoTriState.msoTrue)
oPres.SaveAs("c:\mypres.ppt")

'Build Slide #1:
'Add text to the slide, change the font and insert/position a
'picture on the first slide.
oSlide = oPres.Slides.Add(1, PowerPoint.PpSlideLayout.ppLayoutBlank)


oPres.Slides(1).Select()
oShape =
oPres.Slides(1).Shapes.AddShape(Microsoft.Office.Core.MsoAutoShapeType.msoShapeRectangle, 100, 100, 100, 100)
With oShape
.Fill.Transparency = 1.0#
.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
.Height = 141.75
.Width = 141.75
End With

sPic = oSlide.Shapes.AddPicture("C:\X.jpg",
Microsoft.Office.Core.MsoTriState.msoCTrue,
Microsoft.Office.Core.MsoTriState.msoCTrue, 0, 0, 400, 400)
oSlide = Nothing

With
oApp.ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add(1)
interEffect = .AddEffect(oShape,
PowerPoint.MsoAnimEffect.msoAnimEffectFly,
PowerPoint.MsoAnimTriggerType.msoAnimTriggerOnShapeClick)
interEffect.Shape = sPic

With interEffect
.EffectParameters.Direction =
PowerPoint.MsoAnimDirection.msoAnimDirectionLeft
.Timing.Duration = 0.5
End With
End With

End Sub
End Class
 
Back
Top