Image capture and dump to a powerpoint script
Image capture and dump to a powerpoint script
(OP)
Does anyone know of a script that will capture an image, load powerpoint and insert the picture in 1 step. Also, if powerpoint is already open, it would add to the existing powerpoint (page 2, 3, 4 etc.) I'm being told this exists but have not seen it for myself.





RE: Image capture and dump to a powerpoint script
I just tested it as is with R20 and it works.
Regards,
Derek
Win XP64
R20/21, 3DVIA Composer 2012, ST R20
Dell T7400 16GB Ram
Quadro FX 4800 - 1.5GB
RE: Image capture and dump to a powerpoint script
Thanks Derek
Joe
Mold Designer
RE: Image capture and dump to a powerpoint script
RE: Image capture and dump to a powerpoint script
Yes, can be edit, of course, still, you will need to set up the layout for each slide after capturing the pictures . You need also to edit in line 33 the path and name of the ppt file. I've done also few small improvements (option to capture or not the spec tree and compass, deletion of the temporary picture file at the end of running macro).
Sub CATMain()
' Spec and Compass Off ?
Dim response
response = MsgBox ("Click YES to capture picture without spec tree and compass" & Chr(13) & Chr(13) & "Click NO to capture picture with spec tree and compass", 16 Or 4)
If response = vbYes Then
On Error Resume Next
Dim Window1
Set Window1 = CATIA.ActiveWindow
Dim WindowLayout1
WindowLayout1 = Window1.Layout
Window1.Layout = catWindowGeomOnly
CATIA.StartCommand "CompassDisplayOff"
Else
End If
on error resume next
Catia.ActiveWindow.Viewers.item(1).CaptureToFile 1, "C:\Temp\OBMSectionR1.emf"
On error goto 0
' Set PowerPoint
Dim ppt
On Error Resume Next
Set ppt = GetObject (,"PowerPoint.Application")
If Err.Number = 0 Then
Err.Clear
Else
Set ppt = CreateObject("PowerPoint.Application")
PPT.Visible=True
Set Pres = PPT.Presentations.Open("C:\Temp\Test.ppt")
on error resume next
End If
Set uNewS = ppt.ActivePresentation.slides.Add(ppt.ActivePresentation.slides.count + 1 , 2)
If (err) then
Set uNewP = ppt.Presentations.Add(True)
ppt.Visible = true
ppt.windowstate = 2
Set uNewS = uNewP.slides.Add(uNewP.slides.count + 1 , 2)
else
Set uNewP = ppt.ActivePresentation
End if
On error goto 0
uNewS.Layout = 12
uuInput = 1
uPictureFormat = 0
call ppt.Windows.item(1).Activate
call pasteGraphic( ppt, uNewP, ab, uMultiGraph )
CATIA.ActiveWindow.ActiveViewer.FullScreen = false
End Sub
'----------------------------------------------------------------------------------------
Public Function pasteGraphic( ppt, uNewP, ab, uuInput )
ppt.ActiveWindow.view.GotoSlide(uNewP.slides.count)
fullname = "C:\Temp\OBMSectionR1" & uuInput-1 & ".emf"
If uuInput < 2 then fullname = "C:\Temp\OBMSectionR1.emf"
set oyoy = ppt.ActiveWindow.Selection.SlideRange.item(1).Master
ppt.ActiveWindow.Selection.SlideRange.Shapes.AddPicture(fullname, 0,1,65,68,595,450).select
Set yoyo = ppt.ActiveWindow.Selection.ShapeRange.item(1)
yoyo.PictureFormat.Contrast = 0.5
yoyo.PictureFormat.Brightness = 0.5
yoyo.PictureFormat.ColorType = 1
yoyo.PictureFormat.TransparentBackground = 0
yoyo.Fill.Visible = 0
yoyo.Line.Visible = 0
yoyo.Rotation = 0
yoyo.PictureFormat.CropLeft = 0
yoyo.PictureFormat.CropRight = 0
yoyo.PictureFormat.CropTop = 0
yoyo.PictureFormat.CropBottom = 0
yoyo.LockAspectRatio = -1
yoyo.ScaleHeight 1, 1, 0
yoyo.ScaleWidth 1, 1, 0
yoyo.Width = oyoy.Width
if (oyoy.Height < yoyo.Height ) then yoyo.Height = oyoy.Height
'''''set distance from top and left side
yoyo.top = 80
yoyo.Left = 0
ppt.ActiveWindow.Selection.Unselect
'Back Spec and Compass
Dim Window1
Set Window1 = CATIA.ActiveWindow
Dim WindowLayout1
WindowLayout1 = Window1.Layout
Window1.Layout = catWindowSpecsAndGeom
CATIA.StartCommand "CompassDisplayOn"
On Error GoTo 0
Set PptObject = Nothing
Set Viewer1 = Nothing
''''''''''''''delete captured picture
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile"C:\Temp\OBMSectionR1.emf"
Set fso = nothing
End Function
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
RE: Image capture and dump to a powerpoint script
RE: Image capture and dump to a powerpoint script
RE: Image capture and dump to a powerpoint script
Perhaps the problem child's settings do not include all the language libraries. Tools - Options - Parameters and Measure - Knowledge Environment. Both options should be checked.
Regards,
Derek
Win XP64
R20SP7/21SP5, 3DVIA Composer 2013, ST R20
Dell T7400 16GB Ram
Quadro FX 4800 - 1.5GB
RE: Image capture and dump to a powerpoint script
RE: Image capture and dump to a powerpoint script
I like the enhancements.
Regards,
Derek
Win XP64
R20SP7/21SP5, 3DVIA Composer 2013, ST R20
Dell T7400 16GB Ram
Quadro FX 4800 - 1.5GB
RE: Image capture and dump to a powerpoint script
Error is saying that the file cannot be found (line 67)
If uuInput < 2 then fullname = "C:\Temp\OBMSectionR1.emf"
So, do you have a Temp folder where the file should be created temporary and delete at the end of running script?
If not, should be created previously to run the macro.
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
RE: Image capture and dump to a powerpoint script
That was the problem. All fixed now.