The strangest thing is happening with my macro in Excel. It works like a charm, but when it has to copy 2 charts and paste into my powerpoint presentation, suddenly, the Chart isn't exactly the same.
My code:
Set Wb = Workbooks.Open("Path\WbName.xlsx", ReadOnly:=True, UpdateLinks:=0)
It opens 5 more workbooks... And then it goes through a loop, to copy all the Charts
Dim Charts_Arr As Variant
Charts_Arr = Worksheets("Parameters").ListObjects("Parameters").DataBodyRange.Value
For i = LBound(Charts_Arr) To UBound(Charts_Arr)
SourcePath = Charts_Arr(i, 8)
SheetName = Charts_Arr(i, 4)
ShapeNr = Charts_Arr(i, 2)
SlideNr = Charts_Arr(i, 3)
Schaling = Charts_Arr(i, 6)
Set Source = Workbooks(SourcePath)
Set PPpres = oPPTApp.ActivePresentation
Set Sh = Source.Sheets(SheetName).Shapes(ShapeNr)
Sh.Copy
Set NewSh = PPpres.Slides(SlideNr).Shapes.PasteSpecial(ppPasteJPG)
With NewSh
.Top = Charts_Arr(i, 5)
.Left = Charts_Arr(i, 7)
.ScaleHeight Schaling, msoTrue
End With
Next i
This goes perfectly. But when I take a look at the ppt-file, 2 charts are not exactly the same.
(TIP: Excel is Chartarea, not a shape - didn't know this at first)
When copy the picture manually, I get the correct picture:
And what's more bizarre, I have 2 other Charts on another Sheet in the same workbook who doesn't cause any problems.
Could this be a problem with links, or the way I copy?
UPDATE
If I adjust the code as suggested below:
Source.Sheets(SheetName).ChartObjects(ShapeNr).Chart.CopyPicture
Set NewSh = PPpres.Slides(SlideNr).Shapes.Paste
With NewSh
.Top = Charts_Arr(i, 5)
.Left = Charts_Arr(i, 7)
.ScaleHeight Schaling, msoTrue
End With
I get this:
I'm doing something wrong with the Paste part of the code, I guess.
Tried other possibilities, always end up getting no images, or the one above.
FIXERSUPDATE
So I made/used a loophole. Couldn't find a way to paste the images directly into Powerpoint, So I pasted it into an excelsheet 'Temp' instead. And adjusted the Array, and that seemed to work. But I still would like to know how to do this directly in Powerpoint.
Thanks in advance for your insights!
I couldn't find a PasteSpecial Option that could fix the issue.
CopyasPicture works, but I can't seem to figure out how to paste it directly into ppt. So I used a workaround. I created a 'Temp' Sheet, where I could paste the Chart as Picture in the right format, afterwards I could program it to paste the shape into Ppt. Not the cleanest way to solve the issue, but it works.
Related
I have a PowerPoint presentation in which I create charts in Excel and then link them into the PowerPoint. There are two ways to do this:
Paste Special > Paste Link > Microsoft Excel Chart Object
Paste > Keep Source Formatting and Link Data / Use Destination Theme and Link Data
I would late like to use VBA to change the source Excel file. To do this, consider the following code:
Private Sub PrintLinks()
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
Set pptPresentation = ActivePresentation
For Each pptSlide In pptPresentation.Slides
For Each pptShape In pptSlide.Shapes
If pptShape.Type = msoChart Or pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoLinkedChart Then
Debug.Print pptShape.LinkFormat.SourceFullName
pptShape.LinkFormat.SourceFullName = "PATH/TO/NEW/FILE"
pptShape.LinkFormat.Update
End If
Next
Next
End Sub
This will work for the Paste Link case, but not the Link Data case, in which case pptShape.Type = msoChart. My question is if there is a way to make it work with Link Data as well. Wtih Paste Link, the SourceFullName property will point to a specific chart object, like filename1.xlsx!Chart 1, and changing it to filename2.xlsx!Chart 1 will work as expected. In contrast, under the Link Data option the SourceFullName property only points to filename1.xlsx and I cannot figure out how to see what chart object within the file it is pointing to. Regardless, if I change SourceFullName to filename2.xlsx no error will be thrown, but as far as I can tell the pointer is still to filename1.xlsx, as the chart doesn't change.
I'm slowly getting crazy because of this problem. I'm creating a powerpoint presentation from an excel workbook, where data needs to be filled in. I'm creating multiple slides already with no issues and tackled most problems already.
One of the final things for me to do is copy a chart from excel and pasting it in my ppt. This has worked before, but suddenly it just breaks, it doesnt want to paste the chart anymore.
In my main module I call sub ROI with some required data to continue
Call ROI(PPPRes, Slidestart, language, i)
This is in a seperate Module to keep things clean in the main module
Sub ROI(PPPRes, Slidenumber, language, proposal)
Set pp = CreateObject("PowerPoint.Application")
Dim oPPTShape As PowerPoint.Shape
Dim PPSlide As PowerPoint.Slide
Dim ColumnWidthArray As Variant
Dim i As Integer
'Create a slide on Slidenumber location
Set PPSlide = PPPRes.Slides.Add(Slidenumber, ppLayoutTitleOnly)
PPSlide.Select
PPSlide.Shapes("Title 1").TextFrame.TextRange.Text = Range("Titlename in chosen language")
PPSlide.Shapes.AddTable(3, 3).Select
Set oPPTShape = PPSlide.Shapes("Table 4")
'Filling in data in the table from an excel table. Basic stuff working with a few loops to make this happen
'Changing the width of the created table, column by column
ColumnWidthArray = Array(37, 210, 180)
Set oPPTShape = PPSlide.Shapes("Table 4")
On Error Resume Next
With oPPTShape
For i = 1 To 3
.table.columns(i).width = ColumnWidthArray(i - 1)
Next i
.Top = 180
.Left = 520
.height = 200
End With
'Add a rectangle on the slide
PPSlide.Shapes.AddShape Type:=msoShapeRectangle, Left:=404, Top:=400, width:=153, height:=43
'Copy a picture from excel and paste it in the active slide
Sheets("Shapes").Shapes("ROI_img").Copy
PPSlide.Shapes.Paste.Select
pp.ActiveWindow.Selection.ShapeRange.Left = 800
pp.ActiveWindow.Selection.ShapeRange.Top = 20
'Copy chart from excel (with index number that is linked to "proposal") and then paste onto slide
Sheets("Proposals").Shapes("ChartInvProp" & proposal).Copy
PPSlide.Shapes.Paste.Select
Set oPPTShape = PPSlide.Shapes("ChartInvProp" & proposal)
With PPSlide.Shapes("ChartInvProp" & proposal)
.Left = 20
.Top = 120
.width = 480
.height = 320
End With
end sub
So everything in the code is executed, but most of the time the chart from excel is NOT being pasted onto the slide.
However, if I checked what is in the clipboard by breaking the code just after copying the chart from excel. And I then manually paste whatever is in the clipboard into a Word document I will see the chart. --> The action of copying the chart is being executed, but not the pasting part
If I now continue after the break, the chart will be pasted on the powerpoint somehow. But if I do NOT break the code, and let it run its course, the chart will not be pasted.
Somehow it seems to need more time after copy before it can actually paste the chart. I dont really understand what is happening here.
Sometimes it only pastes Chart 1 in the slide, and when it loops for the second/third/etc... chart it doesnt want to paste it anymore.
It really is very random, and I only see a little bit of structure in it not executing...
This was the solution, using a 'DoEvents' between copy and pasting.
This issue only occurred with Charts made in Excel, if I made the charts into pictures it worked without a problem. But copy/pasting a chart from Excel apparently takes more processing time and was slower than the program run speed. So it would skip from time to time.
Sheets("Proposals").Shapes("ChartInvProp" & proposal).Copy
DoEvents
PPSlide.Shapes.Paste.Select
Got the answer from:
Error in script which copies charts from Excel to PowerPoint
I'm writing a VBA script to copy+paste charts from an Excel worksheet to an existing Powerpoint presentation as Picture.
So far I was successful to do the copy-paste as Picture, but failed to change the size of the pasted picture. I believe the pasted picture is a shape, so I'm trying to do something like:
For Each iChart In arrChart
xlWorkBook.Worksheets("PPT").ChartObjects(iChart).CopyPicture
ActivePresentation.Slides(iCurrSlide).Shapes.Paste
'Reshape
ActivePresentation.Slides(iCurrSlide).Select
With ActivePresentation.Slides(iCurrSlide).Shapes.Item(5)
.Select
.Height = ActiveWindow.Presentation.PageSetup.SlideHeight
.Width = ActiveWindow.Presentation.PageSetup.SlideWidth
.Left = 0
.Top = 0
End With
iCurrSlide = iCurrSlide + 1
Next iChart
However I seem to get the wrong index, so I'm wondering if there is a way to capture the index of the picture (as a shape)? I have my hands tied as I cannot name the picture (if I'm to name each picture pasted, I'd rather throw the script into garbage can and simply paste manually), and I cannot change anything about the pptx and xlsx.
Avoid selecting anything unless it's absolutely necessary, which it seldom is.
Assuming this is happening in VBA within PPT:
Dim oSh as Shape
For Each iChart In arrChart
xlWorkBook.Worksheets("PPT").ChartObjects(iChart).CopyPicture
' Set a reference to the just-pasted shape
Set oSh = ActivePresentation.Slides(iCurrSlide).Shapes.Paste(1)
'Reshape
' You don't need this:
' ActivePresentation.Slides(iCurrSlide).Select
' With ActivePresentation.Slides(iCurrSlide).Shapes.Item(5)
With oSh
' No need to select it as long as you've got a reference to it:
'.Select
' I'd use ActivePresentation.PageSetup here but it may not matter
.Height = ActiveWindow.Presentation.PageSetup.SlideHeight
.Width = ActiveWindow.Presentation.PageSetup.SlideWidth
.Left = 0
.Top = 0
End With ' oSh
iCurrSlide = iCurrSlide + 1
Next iChart
I've searched through out Google and on here for a proper answer and I can't seem to find one...
I have an image on "Sheet2" that I want to copy over to "Sheet1", the image's name is static and doesn't change. I've got the below code to delete the already existing image on "Sheet1" and now I need it to be replaced with the image from "Sheet2"
Sub CheckImageName()
For Each shape In ActiveSheet.Shapes
If Not Intersect(shape.TopLeftCell, Range("L77:AM97")) Is Nothing Then
shape.Delete
End If
Next shape
End Sub
Every method I saw was using .Select and pasting into the area, however I'm really trying to avoid using the .Select and .Paste methods as I've read all over SO and other sources that it's best to avoid using .Select.
I found a response for Word that could apply for your question.
Copy shape in Word 2010 without .Select?
Sub createShape()
Set myshape = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 100)
Set anothershape = myshape.Duplicate
End Sub
I'm updating my MS PowerPoint by pasting images on different slides using VBA.
Rest of the code is working fine. What I'm unable to do is delete the existing image on all the slides and paste the new image. Currently it paste the new image on top of old image, but old image remains. I'm using below code:
Dim pptApp As PowerPoint.Application
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
xlApp.Worksheets(2).Range("M2:S12").Copy
Set shp1 = ActivePresentation.Slides(17).Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)
With shp1
.Left = 370
.Top = 100
.Height = 360
.Width = 340
End With
Being a newbie to VBA, I dont know where and how to add delete command in above code. Any kind of help would be appreciated.
This (thanks, L42) will work for single msoPicture shapes on a slide, but if there's more than one shape, it may miss some:
Dim s As Shape
For Each s In ActivePresentation.Slides(17).Shapes
If s.Type = 13 Then s.Delete '13 is msoPicture
Next
Why? Suppose you have three shapes on the slide. We iterate through the shapes collection, find that the first shape is a picture and delete it. Now there are two shapes in the shapes collection, but VBA's counter doesn't take account of changes in the collection count. It looks at the second shape in the collection, but that's now what WAS the third shape on the slide, so the code will miss shape #2 altogether.
It's more reliable to use something like this:
Dim x as Long
For x = ActivePresentation.Slides(17).Shapes.Count to 1 Step -1
If ActivePresentation.Slides(17).Shapes(x).Type = msoPicture Then
ActivePresentation.Slides(17).Shapes(x).Delete
End If
Next
Edit1: As what Steve pointed out, the first posted solution is unreliable; also as confirmed in this POST by Doug.
To delete all pictures using loop, take Steve's approach as explained in his post.
Now, if you just want to delete all the pictures, you can try this:
ActivePresentation.Slides(17).Shapes.Range.Delete
But this deletes all shapes, not only pictures but textboxes, lines, shapes etc.
To delete only pictures, below is another approach using loop.
Dim s As Shape, pictodel As Variant
For Each s In ActivePresentation.Slides(17).Shapes
If s.Type = 13 Then
If IsArray(pictodel) Then
ReDim Preserve pictodel(UBound(pictodel) + 1)
pictodel(UBound(pictodel)) = s.Name
Else
pictodel = Array(s.Name)
End If
End If
Next
ActivePresentation.Slides(17).Shapes.Range(pictodel).Delete
Hope this helps but a simpler solution would be Steve's. :)