I need to copy excel data to powerpoint slides but shape get truncated after paste special.
This is my code:
Set myShape = mySlide.Shapes("obj" & i)
mySlide.Shapes.PasteSpecial DataType:=2
Set newShape = mySlide.Shapes(mySlide.Shapes.Count)
newShape.LockAspectRatio = msoFalse
newShape.Left = myShape.Left
newShape.Top = myShape.Top
newShape.Height = myShape.Height
newShape.Width = myShape.Width
myShape.Delete
I need to replace existing shapes same as their properties so I first get the shape and set its properties to new shape and then delete it.
Before I run the code the shape is this:
After shape is this(truncated):
I tried other data types also but in vain.
I fixed the problem my self when i debug the code. The problem was that the range array gets changed when i run the code. So, after fixing it, than shape no more truncates.
Related
I had a question earlier about how to import data into PowerPoint using PowerPoint VBA and ended up finding a solution from Excel VBA. That being said I haven't found a solution that works for Excel because it gives me errors despite copying and pasting the exact code.
strPic ="Picture Name"
Set shp = ws.Shapes(strPic)
'Capture properties of exisitng picture such as location and size
With shp
t = .Top
l = .Left
h = .Height
w = .Width
End With
ws.Shapes(strPic).Delete
Set shp = ws.Shapes.AddPicture("Y:\our\Picture\Path\And\File.Name", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic
shp.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
shp.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
This did NOT work for me because it said the method is not found.
The solution I am looking for can be on either PowerPoint VBA or Excel VBA, I am not picky. Even if it is 1 line of code that does it one time, and doesn't use fancy looping I am ok with that as well because I would rather iterate 100 lines of code and change the slide number than beat my head against the wall trying to find answers to this issue!
TL:DR
VBA Code in Excel or PowerPoint that will allow me to select a named shape in a PowerPoint Slide and then insert a .png image from a folder.
Literally I want this line of code to work, but it doesn't
Set shp = ws.Shapes("Named Shape").AddPicture("Y:\our\Picture\Path\And\File.Name", msoFalse, msoTrue, l, t, w, h)
I have tried this For Excel VBA:
oPPTFile.Slides(100).Shapes("Name").Fill.UserPicture("D:\Pictures\Picture.png")
but it didn't work even though that was the exact same code style I used to replace text in differently named shapes...
oPPTFile.Slides(100).Shapes("Different Name").TextFrame.TextRange.Text = "Some Text"
Maybe instead of oPPTFile it's something else and oPPTFile is meant for text? I don't know, this is where I am stuck!!!
I finally found my answer:
Sub main()
Dim objPresentaion As Presentation
Dim objSlide As Slide
Dim objImageBox As Shape
Set objPresentaion = ActivePresentation
Set objSlide = objPresentaion.Slides.Item(1)
Set objImageBox = objSlide.Shapes.AddPicture("D:\Folder\Picture.png", msoCTrue, msoCTrue, 100, 100)
End Sub
The 100, 100 as near as I can tell ensures that whatever picture you import to the slide object fills the entire object. Key take aways: The shape has to be able to recieve images, and it has to be present on the slide already. Beyond that Item(#) refers to the Slide #, not the shape #. If I am wrong as to why this code works the way it does please correct me, but I have seen a LOT of questions about this subject and very few answers that were straightforward.
Now that being said this is NOT a loop, and I have no idea how to make this a loop process. You can iterate those Set lines as often as you like and it WILL work pretty quickly as well. 100 images maybe took a minute, probably less.
So hopefully this helps someone in the future!
Maybe that explains the problem I am having. I have the shape in the exact place I want the picture to show up. That being said, when it imports, and it does import correctly, when I try to use
With shp.Fill.PictureEffects
Dim eff As PictureEffect
Set eff = .Insert(msoEffectSharpenSoften)
eff.EffectParameters(1).Value = 1
End With
Only some of the pictures work???
Use this instead of the existing code in your example file. I changed the Value to -9 to make it more obvious; you can change that back to whatever you want. This now works with both pictures and pictures in placeholders.
Sub EsoteraCardInitialFormatting()
Dim currentSlide As Slide
Dim shp As Shape
Dim eff As PictureEffect
For Each currentSlide In ActivePresentation.Slides
For Each shp In currentSlide.Shapes
Select Case shp.Type
Case msoPicture
With shp.Fill.PictureEffects
Set eff = .Insert(msoEffectSharpenSoften)
eff.EffectParameters(1).Value = -9
End With
Case msoPlaceholder
If shp.PlaceholderFormat.ContainedType = msoPicture Then
With shp.Fill.PictureEffects
Set eff = .Insert(msoEffectSharpenSoften)
eff.EffectParameters(1).Value = -9
End With
End If
End Select
Next
Next
End Sub
This is my PowerPoint file:
https://www.dropbox.com/s/7my3ubmnv7rxv8y/temp.pptx?dl=0
This is my code to change image of shape:
Dim presentation As Object
Set ppt = CreateObject("PowerPoint.Application")
Set presentation = ppt.Presentations.Open2007("D:\2018\temp.pptx", MsoTriState.msoFalse, MsoTriState.msoFalse, MsoTriState.msoTrue)
Dim oSlide As Object
Set oSlide = presentation.Slides(1)
oSlide.Shapes("Picture").Fill.UserPicture ("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg")
How can I change the image of the Shape object?
What you are trying to do is to create a fill, which doesn't work because the shape in question is a picture. You can try it out yourself in PowerPoint. Setting a fill to a picture has no effect because the original image is still visible. That's why you see no result.
You can't change the picture itself, you have to delete it, and then replace. So you can amend the necessary section of your code as follows:
Set shp = oSlide.Shapes("Picture")
'Capture properties of the existing picture such as location and size
With shp
t = .Top
l = .Left
h = .Height
w = .Width
End With
shp.Delete 'Delete old shape
Set shp = oSlide.Shapes.AddPicture("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", msoFalse, msoTrue, l, t, w, h)
shp.Name = "Picture"
shp.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
shp.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
Of course, you can make your initial shape a rectangle (or other drawing objects) and then Fill it with a picture. In this case, you can always change the Fill and the picture used for it, something like this:
Dim link as String 'set this to the address of the picture you want to use to fill
oSlide.Shapes(shp).Fill.UserPicture(link)
But if the original shape is a Picture itself, you usually can't fill it with another picture.
I am using an Excel VBA to update PowerPoint presentation. I am trying to embed two excel files into one of the slides and I have set all the parameters but the size and position bit does not seem to be working.
MyPresentation.Slides(9).Shapes.AddOLEObject Left:=142, Top:=142, Width:=200, Height:=170, Filename:=Met2FactSheet, _
DisplayAsIcon:=msoTrue, IconLabel:="Metro2 Fact Sheet"
The object is embedded but with no sizing at all (as if I have omitted that part of the code).
Try assigning it to an object variable first, and then try setting the properties. For example...
Set ppShape = MyPresentation.Slides(9).Shapes.AddOLEObject( _
Filename:=Met2FactSheet, _
DisplayAsIcon:=msoTrue, _
IconLabel:="Metro2 Fact Sheet")
With ppShape
.Left = 142
.Top = 142
.Width = 200
.Height = 170
End With
If you're using early binding, you can declare ppShape as PowerPoint.Shape. Otherwise, if you're using late binding, you can declare ppShape as Object.
Hope this helps!
I have a presentation and I have to update it every week. The information I update are a bunch of imagens I generate from a Excel pivot tables (copy from Excel and paste directly on PowerPoint).
Today I can do this doing this:
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set PPTPrez =
objPPT.Presentations.Open("\\network_folder\presentation.pptm")
Set pSlide = PPTPrez.Slides(2)
If pSlide.Shapes.Count <> 0 Then
ActiveWorkbook.Sheets("Pivot1").Range("A8:Z18").CopyPicture
pSlide.Shapes.Paste
EndIf
It work flawless... But I need a litle bit more control and precision...
I need to select the current image on slide, delete it and paste the new one in the same location... Some slides have 3 images or more...
I cann't figure it out how to properly tell to VBA what image are what and choose the pivot table with the correct info for that image... I don't even know if this is possible...
But another solution I have tried is how to specify the position and dimensions of the image on the slide... I can before update, delete all imagens... In this scenario, how to specify the dimensions and positioning?
Thanks!!!
Ps.: Sorry my bad english
This example (based on your code) may point you in the right direction. You need to know the powerpoint shape name (which you can get via VBA or via the ribbon Home-Select-Selection Pane.
Option Explicit
Public Sub UpdateShapes()
Dim vPowerPoint As PowerPoint.Application
Dim vPresentation As Presentation
Dim vSlide As Slide
Dim vShapeName As String
Dim vShape, vNewShape
Set vPowerPoint = New PowerPoint.Application
vPowerPoint.Visible = True
' Open the powerpoint presentation
Set vPresentation = vPowerPoint.Presentations.Open("\\network_folder\presentation.pptm")
' Set slide to be worked on
Set vSlide = vPresentation.Slides(2)
' Set shape to (for this example) "Picture 3"
vShapeName = "Picture 3"
Set vShape = vSlide.Shapes(vShapeName)
' Copy and paste new shape (picture) of range specified
ThisWorkbook.Sheets("Sheet1").Range("A6:B9").CopyPicture
Set vNewShape = vSlide.Shapes.Paste
' Align size and position of new shape to that of old shape
With vNewShape
.Width = vShape.Width
.Height = vShape.Height
.Left = vShape.Left
.Top = vShape.Top
End With
' Delete original shape, rename new shape to original so code works next replace cycle
vSlide.Shapes(vShapeName).Delete
vNewShape.Name = vShapeName
End Sub
I am trying to rotated my 3D Column chart. So far I have the following:
ActiveChart.Name = "44 Chart 7"
With ActiveChart
.SetSourceData Source:=pzx.Range("L126:M135")
.HasTitle = False
.HasTitle = True
.Shapes("44 Chart 7").ThreeD.RotationX = 0
.ChartTitle.Text = "Classification Actions"
.ChartArea.Font.Color = RGB(0, 0, 140)
.ChartTitle.Font.Name = "Arial"
.ChartTitle.Font.Size = 10
.Legend.Font.Size = 8
.Legend.Font.Name = "Arial"
.ChartStyle = 11
.ChartArea.Format.Line.Visible = msoFalse
End With
I have two questions -
1) what determines how a chart is named if you do not actively name the chart yourself
2) do you know why this code does not work
Here is the error I received -
Run-time error 7
Out of Memory
Thanks so much!
Naming objects have naming conventios that you must follow. For charts: when a chart is on a worksheet the Name property applies to the ChartObject object which is the container for the Chart.
With Chart
.Parent.Name = "myChartName"
End With
or
`Sheets(1).ChartObjects(3).Name = "Name of my Chart"`
or
`Sheets(1).Charts("My old Chart Name").Name = "Name of my Chart"`
If you know where your chart is residing, point to chart with sheet reference to be in the safe side than using ActiveChart. If you do not actively name the chart, then you must use chart's default original name to refer to it. Or its index.
Please try this code piece in your end.
Option Explicit
Sub createMyCharts
Dim mySheet As Worksheet
Dim mychtObject As ChartObject
Dim myChart As Chart
'-- put anything else you need to delcare and set
Set mySheet = Worksheets(1) '-- set according to your sheet
'-- delete any old leftovers to clean up
For Each mychtObject In mySheet.ChartObjects
mychtObject.Delete
Next
'-- create new chart
Set myChart = mySheet.ChartObjects.Add(Left:=30, Width:=500, Top:=30, Height:=200).Chart
With myChart
.ChartType = Excel.XlChartType.xl3DColumn '-- the full chart Type
.SetSourceData(mySheet.Range("L126", "M135"), Excel.XlRowCol.xlColumns)
.Rotation = 30
End With
'-- do anything else you need to do
End Sub
Reference to MSDN Chart Rotation
After trying out, you may comment and happy to help futher if you have any questions. :)