Dear Fellow StackOverFlow-members,
is there a possibility to copy a picture from an userform into a slide?
I've tried several approaches:
ActivePresentation.Slides(1).Shapes.AddPicture 'Filename has to be a string, thus i can't set the Userform as source
I've thought of something like frm_Userform.Image1.Picture to get somehow the picture, but I have no idea to set the picture within a slide.
The possibilties to pre-define a picture path is not possible as several users with different user rights are going to use the makro (add-in).
Are there maybe other possibilities to save a picture within an add-in and use (paste) it on slides ?
Thank you in advance!
Can you put the logo files in a known location? Then you can add them with something like:
IconFile$ = AddinPath$ & "\YellowIcon.gif"
Set ShO = PresO.Slides(1).Shapes.AddPicture(FileName:=IconFile$, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=10, Height:=10)
With ShO
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
End With
Sub CopyFromUserFormToSlide
Const TempFolder = 2
Dim fso, path
Set fso = CreateObject("scripting.filesystemobject")
path = fso.GetSpecialFolder(TempFolder).Path & "\" & fso.GetTempName
SavePicture UserForm.Image1.Picture, path
ActivePresentation.Slides(1).Shapes.AddPicture path,msoFalse,msoTrue,150,150
fso.DeleteFile path
End Sub
This did the job for me. Excel solution was on stack and had to adjust it to PowerPoint. Thank you anyway!
Related
I have a code to paste object from a slide to the active slide. How can I make the code to paste it inside the master instead?
Public Function AddShapeBooktitle()
Dim s As String, p As Presentation, o As Shape
'open the file and copy the object
If CommandBars.ActionControl.Parameter <> "" Then
s = Ini.GetResourcePath & CG_ADDIN_NAME & "\" & CG_INSERT_FOLDER & CG_BOOKTITLE_FOLDER & CommandBars.ActionControl.Parameter
Set p = Presentations.Open(s, ReadOnly:=True, WithWindow:=msoFalse)
p.Slides(1).Shapes.Range().Copy
p.Close
ActiveWindow.Selection.SlideRange(1).Shapes.Paste
Else
MsgBox "The Shape file name is missing.", vbExclamation, "Shape file name missing."
End If
End Function
Appreciate any pro help out there! Thanks!
You'll need to identify the current slide's custom layout, and then paste the shapes into the appropriate layout in the SlideMaster. Something like this works within a single presentation. If you're working between multiple presentations with potentially different SlideMaster collections, you may need to adjust the logic somehow. But this is the general idea: you need to identify which of the SlideMaster.CustomLayouts will be the destination for the Paste operation.
Option Explicit
Sub foo()
Dim p As Presentation
Dim sld As Slide
Dim layout As CustomLayout
Set p = ActivePresentation
Set sld = p.Slides(1)
layout = sld.CustomLayout.Index
sld.Shapes.Range().Copy
p.SlideMaster.CustomLayouts(layout).Shapes.Paste
End Sub
.addPicture requires width and height, but this could end up distorting the image. Is there any way to use .LockAspectRatio = msoCTrue when adding the file image?
Also, how do you stipulate a page to put the canvas or the picture? Macro recorder needs to be stopped before one can work on images somehow.
Set sCanvas = ActiveDocument.Shapes _
.AddCanvas(Left:=MillimetersToPoints(20), Top:=MillimetersToPoints(20), _
Width:=300, Height:=200)
Set CanvasShapes = sCanvas.CanvasItems
With CanvasShapes
.AddPicture FileName:="C:\somepath\image.png", _
Left:=0, Top:=0, Width:=150, Height:=100
...
End With
Set the canvas size to 0 and lock it's aspect ratio, then add the picture. The canvas will scale to accommodate it. After the image is loaded, then scale the canvas as needed:
Set sCanvas = ActiveDocument.Shapes.AddCanvas(MillimetersToPoints(20), MillimetersToPoints(20), 0, 0)
sCanvas.LockAspectRatio = True
Set CanvasShapes = sCanvas.CanvasItems
With CanvasShapes
.AddPicture "C:\somepath\image.png"
End With
'Scale the canvas here.
You could try to obtain the dimensions using the code here (pasted below for reference)
Sub test()
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Dim fPath As Variant 'MUST be a variant, not a string
Dim fName As String
fPath = "C:\somepath"
fName = "image.png"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(fPath)
Set objFile = objFolder.ParseName(fName)
MsgBox objFile.ExtendedProperty("Dimensions")
End Sub
This will give you the dimensions of the picture which you can then use.
It looks like the output is ? w x h ? so you'll need to parse it, but this should work.
Note that if you want to use a variable to define the file path, it must be declared as a variant, per here
If you check the definition of the AddPicture method you will find that except for FileName all of the arguments are optional, so Height and Width are not required.
Unless you have a specific reason for adding a canvas it is also unnecessary to add a canvas before adding a picture.
Word has no concept of pages so you cannot specify that the picture should appear on a certain page.
Managed to find a way to put a picture to a specific page (page 2 in example below) in MS Word:
Dim pNum as long
pNum = 2
Selection.GoTo What:=wdGoToPage, Count:= pNum
I was wondering, if there is a maximum number of videos in ppt that one can import via "AddMediaObject2" in VBA?
I get a strange error, if I try to import several videos with the following macro (which is a dummy version just to show the problem) :
Sub loadVideos()
Const path As String = "D:\video.avi"
For folder = 1 To 20
Debug.Print "folder: " & folder
Dim sld As Slide
Set sld = ActivePresentation.Slides.Add(ActivePresentation.Slides.count + 1, ppLayoutTitleOnly)
sld.Select
For i = 1 To 8
Dim oShp As Shape
Set oShp = sld.Shapes.AddMediaObject2(FileName:=(path), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=-1, _
Height:=-1)
Next i
Next folder
End Sub
It works as expected with smaller video files (so code should be alright!?) but I get the error
"Runtime error -214....
Shapes.AddMediaObject2 : Invalid request, PowerPoint cannot insert any video from the chosen file. Check whether the necessary codec for this media format is installed and repeat the procedure.
"
if I use it with larger videos or alternatively increase the number of videos on each slide or the number of slides containing videos.
I doubt that it has something to do with video codecs, because inserting the videos manually works fine and also the videos inserted so far (till the error occurs) work fine. I also checked that RAM is not completely filled by all these inserted videos.
So I suppose there may be some internal stack or cache memory problem in ppt. Is there any restriction to the number or size of media files that can be loaded in ppt?
I would be very grateful, if someone could either tell me that it may be some bug in ppt or may point to some sort of remedy. Maybe I can configure ppt to accept more/bigger videos?
Many thanks.
Same story for me i could only add 8 mpg files (regardles of installed codecs).
Solution is to open and close presentation after adding single file (sample code above)
ps After converting mpg to avi method works fine...
For Each myBrand In Brands
Set ReturnPPPresentation = PptApp.Presentations.Open(tmpPresenationPath, withwindow:=msoFalse)
Set mySlajd = PPTTemplate.Slides(2).Duplicate
With mySlajd
Set shp = .Shapes.AddMediaObject2(myBrand.MultimediaPath, msoFalse, msoTrue, 218, 118.22, 384.71, 211.77)
Set shp = Nothing
End With
ReturnPPPresentation.Save
ReturnPPPresentation.Close
Next myBrand
So for my particular application, I want to be able to select an image after I've copied it in from Excel, and then insert a caption.
I can successfully copy images using:
docapp.Selection.Range.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
However, I'm having a lot of difficult just selecting the recently copied image so I can use
Selection.InsertCaption
What's the best way to select images?
Ok, I'm an idiot and have solved my own problem. It's not the prettiest code but it works:
The key is to use document.InlineShapes.Select:
Public Sub Chart2Word(chto As Chart, doc1 As Word.Document, docapp As Word.Application, _
Optional Title As Variant)
Dim objpic As Word.InlineShape
docapp.Activate
chto.CopyPicture
docapp.Selection.MoveEnd wdStory
docapp.Selection.Move
docapp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
docapp.Selection.Range.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
doc1.InlineShapes(doc1.InlineShapes.Count).Select
Label = Me.Range("LabelName").value
If Not IsMissing(Title) Then
docapp.Selection.InsertCaption Label:=Label, Title:=": " + Title
End If
I'm struggling to find a way to create a link to another slide with VSTO for powerpoint, does anybody know how to do it ? No way to find any solution on the internet...
Translate this from VBA to VSTO and you should be good to go. Pass it references to the shape you want to apply the link on, and the slide you want to link to.
Sub MakeLink(osh As Shape, oLinkTargetSlide As Slide)
With osh.ActionSettings(1)
.Action = ppActionHyperlink
.Hyperlink.Address = ""
.Hyperlink.SubAddress = oLinkTargetSlide.SlideID & "," & oLinkTargetSlide.SlideIndex & ","
End With
End Sub
You might instead want to declare oSh as Object; then you could pass the Sub either a shape or a TextRange to apply the link to.