I'm trying to copy ranges from an Excel sheet and paste them into slides as tables, then position and resize them. However, when I try to position the shapes in ppt, the .Left method doesn't behave as expected; in the slide thumbnails on the left of the screen the shapes are in the expected positions (centred as in the below code), but when I select the slide the shapes are shifted far to the right of where they ought to be.
I thought it may be using 'centre' as its reference point instead of the left bound of the slide but this doesn't match up with the amount it's offset.
Would really appreciate some help with this - would be good to know if it's a bug in ppt or an error in my code as if it's a bug it has a large impact on the feasibility of this project. For this particular example I could probably use the .Align method as a workaround but for later slides I need to be able to position multiple shapes on the same slide accurately.
I'm using Office 365.
Code below:
Sub PP_export()
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim XLws As Worksheet
Set PPApp = New PowerPoint.Application
Set XLws = ActiveSheet
Set PPPres = PPApp.Presentations.Open("Y:\Research\PROJECTS\2018\Magic Macro\ppt_template_.potx")
PPApp.Visible = True
''Lifestyle Statements
'By Col%
Set PPSlide = PPPres.Slides(3)
Dim LSCol As PowerPoint.Shape
XLws.Range("M106:o126").Copy
PPSlide.Shapes.PasteSpecial ppPasteDefault
Set LSCol = PPSlide.Shapes("Table 2")
With LSCol
.Left = (28.35 * 10.56)
.Top = (28.35 * 3.83)
.Height = (28.35 * 13.21)
.Width = (28.35 * 12.75)
End With
'By Index
Set PPSlide = PPPres.Slides(4)
Dim LSIndex As PowerPoint.Shape
XLws.Range("Q106:s126").Copy
PPSlide.Shapes.PasteSpecial ppPasteDefault
Set LSIndex = PPSlide.Shapes("Table 2")
With LSIndex
.Left = (28.35 * 10.56)
.Top = (28.35 * 3.83)
.Height = (28.35 * 13.21)
.Width = (28.35 * 12.75)
End With
I got the same problem and I run a debug message showing the position after inserting and it seems to be correct. But only the thumbnail looks fine, the actual slide is wrong.
I found out that the position of the table will be correct when activating or displaying the slide before pasting the table. Also if several tables need to be inserted I needed to make a short break of 2 seconds between the paste operations.
My workaround is pretty ugly and I am still searching for the reason. It is likely a bug but maybe it also has to do with some kind of offset of the slide in the background.
You need to loop over the table and the data if you are using a template.
If you already have a table (table 2) on slide 3, then you could use this. just send in the excel file object and the template (path+name)
it may need some tinkering.
Sub Slide_3(ByRef xlWorkBook, Template)
For Each oSh In Presentations(Template).Slides(3).Shapes
Select Case oSh.Name
Case "Table 2"
For i = 1 To 20
For j = 1 To 3
oSh.Table.Cell(i, j).Shape.TextFrame.TextRange.Text = xlWorkBook.Worksheets(24).Cells(105 + i, j + 12).Value
Next j
Next i
'M106:o126
End Select
Next oSh
End Sub
Related
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 have written a small function, based on example provided by producer of Stroke Scribe ActiveX object. This is an plugin which allows us to create in Microsoft Word by VBA Macro an QR Code object.
The problem is with setting up a shape location
shp.Left = 0 + LeftMargin
shp.Top = 0 + TopMargin
I would like to put this shape (QR Code) on specific page on the most left top corner. But sometimes shape jumps to previous page (on bottom) or other location (vertical center).
Can you help me recognize a problem and fix it to locate Shape Object every time top left corner?
Code:
Sub QRCodeGenerator(SOP, BookmarkID, Page, TopMargin, LeftMargin)
Dim doc As Document
Set doc = Application.ActiveDocument
For Each sh In doc.Shapes
If sh.Type = msoOLEControlObject Then
If sh.OLEFormat.ProgID = "STROKESCRIBE.StrokeScribeCtrl.1" Then
sh.Delete
End If
End If
Next
With doc.PageSetup
usable_w = .PageWidth
usable_h = .PageHeight
End With
Dim pg As Range
Set pg = doc.GoTo(wdGoToPage, wdGoToRelative, Page)
Dim shp As Shape
Set shp = doc.Shapes.AddOLEControl(ClassType:="STROKESCRIBE.StrokeScribeCtrl.1", Anchor:=pg)
Dim sMyString As String
sMyString = ActiveDocument.Bookmarks(BookmarkID).Range.Text
sMyString = Replace(sMyString, "FORMTEXT ", "")
shp.LockAspectRatio = msoFalse
shp.Height = InchesToPoints(0.6)
shp.Width = shp.Height
shp.Left = 0 + LeftMargin
shp.Top = 0 + TopMargin ' // usable_h - shp.Height * 3 + TopMargin
Dim ss As StrokeScribe
Set ss = shp.OLEFormat.Object
ss.Alphabet = QRCODE 'StrokeScribe will draw a QR code picture
ss.Text = SOP & ";" & sMyString 'Any text you want to encode in the barcode
ss.QrECL = H 'Changes the default error correction level. This can be omitted
ss.QrMinVersion = 3 'Specifies the minimum barcode size. This can be omitted
ss.FontColor = RGB(0, 0, 0)
' ss.UTF8 = True 'Enable this, if you want to encode national characters for smartphones
If ss.Error Then
MsgBox ss.ErrorDescription
End If
End Sub
Word SHAPE objects must be anchored to a Range. The page location of that Range determines on which page the Shape will display. There's nothing you can do to "lock" a Shape to a particular page.
That said, it is possible to dictate that a Shape always appears in the same location on whichever page the anchoring Range lies.
This is always tricky if you add such a Shape before document editing is finished, because editing can move the anchoring paragraph to a different page. It can help to choose a paragraph as the anchor that's unlikely to move, for example perhaps the first paragraph on the page.
Something I did once, long ago, was write a macro that checks the page locations of Shapes before printing or saving. When inserting and positioning the Shape, I give it a Name that includes the page number. Before printing/saving the macro checks the page number in the Shape name with the page on which the Shape is located. If the two don't match, CUT the Shape and PASTE it to a paragraph on the correct page (it remembers its position settings).
The code sample below demonstrates how to name the Shape, lock the anchor to a specific paragraph and position the Shape flush to the top, left corner of the page.
Sub ShapePosTopLeft()
Dim doc As word.Document
Dim shp As word.Shape
Dim rng As word.Range
Set doc = ActiveDocument
Set rng = doc.GoTo(wdGoToPage, wdGoToRelative, Page)
Set rng = rng.Paragraphs(1).Range
Set shp = doc.Shapes.AddOLEControl(ClassType:="STROKESCRIBE.StrokeScribeCtrl.1", Anchor:=rng)
With shp
.Name = "Shape_Page" & Page
.LockAnchor = True
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Left = 0
.Top = 0
End With
End Sub
I'm working in Excel VBA, creating a PowerPoint presentation.I am trying to place Next and Previous buttons on each slide. I am using the code below:
Dim ppApp As PowerPoint.Application, ppPres As PowerPoint.Presentation, ppSlide As PowerPoint.Slide
Dim shpNextButton As PowerPoint.Shape
Set ppApp = CreateObject("Powerpoint.Application")
Set ppPres = ppApp.Presentations.Open("C:\Users\test1.pptm")
Set ppSlide = ppPres.Slides.Add(ppPres.slides.count + 1, ppLayoutBlank)
Set shpNextButton = ppSlide.Shapes.AddShape(msoShapeActionButtonForwardorNext, 750, 480, 40, 12.5)
With shpNextButton.TextFrame.TextRange
.Text = "Next"
With .Font
.Size = 10
.name = "Arial"
End With
End With
shpNextButton.ActionSettings(ppMouseClick).Action = ppActionNextSlide
This code creates the button with the correct text on it. However in the PowerPoint slide, the button is clickable. When I click on it, it just acts like a regular shape.
Your code works for me when I use an adapted version of it (removing lines 1,3,4 and setting a reference to the current slide for line 5) within the PowerPoint VBE so the only thing I can think of is that the 'pp' constants are not set if you haven't added the PowerPoint library to your project. What do you get in the Immediate window if you type this?
?ppActionNextSlide
It should return 1 if all is ok. If it returns 0 then that's equivalent to ppActionNone which would explain what's happening.
By the way, your code added the button outside of my 4:3 slide so I assume you're using a 16:9 slide layout. It would be better to reference the right hand side of the side less an offset to avoid this potential issue with:
ActivePresentation.PageSetup.SlideWidth
I am trying to add a picture (company logo) into a header by code.
This worked fine so far until there showed up some documents which contain a table in the header, which I want to keep there too.
Problem is: my code adds the picture into the first table cell. What i want is that the picture is positioned in the top right corner of the page (with some margin to the page) .. but outside the table.
How do I need to modify my code to do that? I guess the problem is the Range I use:
Set oSec = ActiveDocument.Sections(1)
Set oHeader = oSec.Headers(wdHeaderFooterFirstPage)
Set Rng = oHeader.Range '<<-- Problem here? What to do if there is a table in the header
Set sh = ActiveDocument.shapes.AddPicture(LogoFile, False, True, 0, 0, , , Rng)
With sh
.Height = LogoDimension
.Width = LogoDimension
.WrapFormat.Type = wdWrapTopBottom
.WrapFormat.Side = wdWrapTopBottom
.WrapFormat.DistanceBottom = MillimetersToPoints(10)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionRightMarginArea
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Left = MillimetersToPoints(0.5) - LogoDimension
.Top = MillimetersToPoints(11.5)
End With
Thanks for any hints!
I was able to test the scenario on my dev machine and could reproduce the problem. Shape management in Word's Headers/Footers is notorious for being "pliable" - this appears to be another one of those things.
What works is to insert the graphic in the paragraph below the table as an InlineShape object, use the ConvertToShape method, then immediately lock the anchor of the Shape so that moving it doesn't shift the anchor position to the nearest paragraph (table cell).
Sub InsertPicInHeaderOutsideTable()
Dim oSec As word.Section
Dim oHeader As word.HeaderFooter
Dim rng As word.Range
Dim sh As word.Shape, ils As word.InlineShape
Set oSec = ActiveDocument.Sections(1)
Set oHeader = oSec.Headers(wdHeaderFooterFirstPage)
Set rng = oHeader.Range
'**** Add the followign four lines to code in your question ****
rng.Collapse wdCollapseEnd
Set ils = rng.InlineShapes.AddPicture(LogoFile, False, True, rng)
Set sh = ils.ConvertToShape
sh.LockAnchor = True
With sh
'and so on...
after some more playing around with it I found the solution:
.LayoutInCell = False
adding this attribute to the shape will lead to positioning the picture as wanted and not affect the table anymore.
edit: this was not entirely correct it seems. The picture is still added to the table .. just not positioned in the cell anymore. If I delete the table for testing the picture gets deleted automatically with it. So this is not an ideal solution still.
I think still the range used is the problem
I have a library of eight images on my PowerPoint slide. Based on a userform input, some of the components get duplicated and renamed by adding a "1" or "2" after the original image's name so that they are differentiable. I then want to group the new images (I am building up an item from the component images). I am able to duplicate the images and line them up correctly, but I am having trouble grouping them. Note that I am not always grouping the same number of items, it is dependent on user inputs.
I receive the error "Shape (unknown member): Invalid request. To select a shape, its view must be active."
I searched and attempted to implement several strategies from the help forums but am coming up empty.
PLEASE HELP!!!
-Kevin
Part of code below because it is very long, but this is where my first problem arises:
Dim Cargo As Shape, Cargo_Dup as Shape, Chemical as Shape, Chemical_Dup as Shape
Set Cargo = ActivePresentation.Slides(2).Shapes("Cargo")
Set Chemical = ActivePresentation.Slides(2).Shapes("Chemical")
Cargo.Name = "Cargo"
Chemical.Name = "Chemical"
With ActivePresentation
Set Cargo_Dup = ActivePresentation.Slides(2).Shapes("Cargo")
With Cargo_Dup.Duplicate
.Name = "Cargo_1st"
.Left = 0
.Top = 540
End With
'CHEMICAL
If Input1 = "Chemical" Then
Set Chemical_Dup = ActivePresentation.Slides(2).Shapes("Chemical")
With Chemical_Dup.Duplicate
.Name = "Chemical" & 1
.Left = 36.74352
.Top = 540 + 0.36
End With
'''''WHERE PROBLEM ARISES'''''
ActivePresentation.Slides(2).Shapes("Cargo_1st").Select
ActivePresentation.Slides(2).Shapes("Chemical1").Select msoFalse
Set Vehicle = ActiveWindow.Selection.ShapeRange.Group
Vehicle.Name = "Vehicle"
'Elseif with a bunch for options where addition grouping occurs
I need some kind of keyboard macro to type this for me:
Never select anything unless you absolutely have to.
You nearly never absolutely have to.
You're asking how to make a view active so that you can select something.
I figure that's the wrong question.
It's more useful to know how to work with shapes WITHOUT having to select them.
Grouping shapes w/o selecting them is a bit tricky, but it can be done.
Here's an example of how you might go about this:
Sub GroupWithoutSelecting()
Dim oSl As Slide
Dim oSh As Shape
Dim aShapes() As String
Set oSl = ActivePresentation.Slides(2) ' or whichever slide you like
ReDim aShapes(1 To 1)
With oSl
For Each oSh In .Shapes
If oSh.Type <> msoPlaceholder Then ' can't group placeholders
' Substitute the real condition you want to use
' for selecting shapes to be grouped here
If oSh.Type = msoAutoShape Then
' add it to the array
aShapes(UBound(aShapes)) = oSh.Name
ReDim Preserve aShapes(1 To UBound(aShapes) + 1)
End If
End If
Next
' eliminate the last (empty) element in the array
ReDim Preserve aShapes(1 To UBound(aShapes) - 1)
' Create a shaperange from the array members and group the shaperange
.Shapes.Range(aShapes).Group
End With ' oSl
End Sub