vba selective copying and pasting on the same powerpoint slide

[vanhunk]

Using copy and Paste to another position on the same slide during presentation
Good day,

I hope what I am trying to do is possible in PowerPoint.

I have a series of shapes and images in a line at the top of a slide.

When I click on any of the shapes or images, that specific shape or image must be copied and pasted in a next line on the same slide, starting from the left. When I click on a second shape or image, that shape or image must be copied and pasted next to the previous one, and so on.

With the push of a button, I would then like to copy whatever is pasted in the second line into a third line on the same slide, this time repeating the pattern a specified number of times.

The final result will look like the picture below.

[vanhunk]

Good day Guys
Are there no one that can solve this question, or is it impossible?

Best Regards
vanhunk

[kmcbest]

Do you mean, just after you clicked on a shape (and hence select it), it should be replicated down, just below the shape selected (you talked about "line" but this is not Word but PPT). But when do you start the macro, before or after the click?

You may want to check out this post to see how to trigger some actions when you click on a shape.

[vanhunk]

Good day kmcbest

Thank you very much for your response. I replied to your questions in RED below:

Do you mean, just after you clicked on a shape (and hence select it), it should be replicated down YES, just below the shape selected YES, but to the left, just below the firs shape in the "line" (you talked about "line" but this is not Word but PPT). But when do you start the macro, before or after the click AFTER, the click, or double-click must copy the shape? The next shape will be in line horizontally to the right of the previous pasted/copied shape.

You may want to check out this post to see how to trigger some when you click on a shape. I will have a look.

Much appreciated and best regards
Vanhunk

[vanhunk]

Greetings

I'm not winning, any help will be appreciated

Thank you so much
Vanhunk

[vanhunk]

Good day

Can I now post the question in a different forum since there is nobody in this forum that can help?

Regards
vanhunk

[Aussiebear]

By all means vanhunk. Clearly your question has not resonated with those who frequent here, for what ever reason. Hopefully someone can assist you.

[kmcbest]

I've asked chatGPT for what you want to achieve, here's the reply:

Yes, it is possible to achieve the functionality you described in PowerPoint by using VBA (Visual Basic for Applications) code.

Assuming that your shapes and images are grouped together, you can use a macro to copy the selected group and paste it into a new location on the same slide. Here is some sample code that will copy the selected shape or image group and paste it into a new line on the slide:

```

Sub CopyAndPaste()
    Dim selectedShape As ShapeRange
    Set selectedShape = ActiveWindow.Selection.ShapeRange
    
    If Not selectedShape Is Nothing Then
        'Copy the selected shape range
        selectedShape.Copy
        
        'Add a new shape range one line below the selected shape range
        Dim newShapes As ShapeRange
        Set newShapes = selectedShape.Parent.Shapes.Range(selectedShape.Count + 1).Duplicate
        
        'Reposition the new shape range to start at the left of the slide
        newShapes.Left = 0
    End If
End Sub

```

To repeat the pattern a specified number of times, you could create another macro that duplicates the second row of shapes and pastes them into a third row, as many times as specified. Here is some sample code that will duplicate the second row of shapes and paste it into a third row a specified number of times:

```

Sub RepeatPattern()
    Dim numOfRepeats As Integer
    numOfRepeats = InputBox("How many times do you want to repeat the pattern?")
    
    Dim secondRow As ShapeRange
    Set secondRow = ActivePresentation.Slides(1).Shapes.Range(Array(2, 3, 4)).Duplicate
    
    Dim i As Integer
    For i = 1 To numOfRepeats
        Dim nextRowTop As Single
        nextRowTop = secondRow.Top + secondRow.Height * i
        
        Dim nextRow As ShapeRange
        Set nextRow = secondRow.Duplicate
        nextRow.Top = nextRowTop
    Next i
End Sub

```

Note that the above code assumes that the shapes and images are on the first slide of the presentation and that they are grouped together. You may need to modify the code to fit your specific situation. Also note that enabling macros in PowerPoint can be a security risk, so you should only run macros from trusted sources.

[John Wilson]

Good demo of why chatGPT doesn't usually answer complex questions!

[vanhunk]

Hi John

At least it had a go at it, which is more than what I had before.

Regards
Vanhunk

[vanhunk]

vba Selective Copying and Pasting Shapes on the Same PowerPoint SlideFor Clarity: After you clicked on a shape (and hence select it), it should be replicated down, just below the shape selected, but to the left, i.e. just below the first shape in the "line".
The macro must be started after the click, or double-click (preferably if possible).
The next shape will be in line, horizontally to the right of the previous copy and pasted shape.
The next step is to repeat the new pattern below this line.
See attached file for clarity - The first slide shows how it looks before doing anything and the second the final result.


I found the following working code from PPTools and tried to modify it for my purpose. The third slide of the attached file shows how it is used. If it can be adapted for copying and pasting or duplicating shapes it would be perfect:

Sub DoItToMe(oShape As Shape)
With oShape
    ' Add code here to do whatever you like with the shape
    ' This will make it unfilled if filled or vice versa
    .Fill.Visible = Not (.Fill.Visible)
End With
End Sub

Any help will be highly appreciated

Best Regards
Vanhunk

[Aussiebear]

Vanhunk, Please stop with the enlarging of font, and all upper case. I know you think it's emphasising the intent of the words/ phrases / sentences etc, but we can all read..... It is so unnecessary. When wrapping your code with code tags, use [ ] brackets not < > an the slash goes in front of the last word "code".

[John Wilson]

This might get you started at least.

Note you can only use in show mode.

copyMe.pptm

[vanhunk]

Dear Aussiebear,

Thank you for bringing it to my attention, I for one really appreciates it if someone does it the way I did it, it just saves time and energy. Why have the functionality if you are not allowed to use it? It is not as if I made it massive you know. It even helps me when I go back to my own posts to quickly pick the ones I am interested in. And yes, you are probably correct, we can all read (although our non English speaking people might also appreciate the focus on exactly on what the post is about. Why don't you run a pole and lets find out.

Vanhunk, Please stop with the enlarging of font, and all upper case. I know you think it's emphasising the intent of the words/ phrases / sentences etc, but we can all read..... It is so unnecessary. When wrapping your code with code tags, use [ ] brackets not < > an the slash goes in front of the last word "code".

[vanhunk]

Hi John,

I like it, I think we are getting there, much appreciated!

Vanhunk

[Aussiebear]

Dear Aussiebear,

Thank you for bringing it to my attention, I for one really appreciates it if someone does it the way I did it,

You might, but we don't.

Why have the functionality if you are not allowed to use it?

. Functionality comes from the use of punctuation not shouting.

Why don't you run a pole and let's find out.

Just post normally and every thing is fine.

[vanhunk]

Good day

I have adapted the code by John Wilson and it is working perfectly, solving the first part of the problem

The following code is in the slides code and a button is used to reset the global iCnt variable to 10:

 Private Sub CommandButton1_Click()
iCnt = 10
End Sub

The following code is in a normal module:

 Option Explicit
Global iCnt As Integer
Sub copyme(oshp As Shape)
Dim newshp As ShapeRange


oshp.Copy
Set newshp = oshp.Parent.Shapes.Paste
newshp(1).Top = oshp.Top + 100
newshp(1).Left = iCnt


iCnt = iCnt + 110


End Sub

The second part is to copy whatever is in the second row a number of times to the third row, i.e. repeat the pattern created in the second line a number of times.

Any further assistance is greatly appreciated.

Best Regards
Vanhunk

[vanhunk]

I have solved it.

The code lets you click on any shape on a PowerPoint slide in Presentation Mode to copy and paste it to a new position on the slide, in sequence. I.e., pasted shapes will be next to each other in a line, not overlapping. When a new line is selected (with the applicable button), it starts pasting on the new line. If you make a mistake, the last pasted shape can be deleted. You can change the X-position of the past position with the applicable button and delete all the pasted shapes, ending up with the slide in its original condition. All of this must be executed from within Presentation Mode.

Public Variables:

Public yCnt As Integer
Public zCnt As Integer
Public Const yZero As Integer = 0
Dim lastPastedImage As Shape

Code activated by clicking on any shape on the slide in Presentation Mode (Code in Normal Module):

Sub copyme(oshp As Shape)
    Dim newshp As ShapeRange
    oshp.Copy
    Set newshp = oshp.Parent.Shapes.Paste
    newshp(1).Top = oshp.Top + yCnt
    newshp(1).Left = xCnt
    zCnt = xCnt
    xCnt = xCnt + oshp.Width + 10
    ' Set lastPastedImage = ActivePresentation.Slides(1).Shapes(ActivePresentation.Slides(1).Shapes.Count)
    Set lastPastedImage = ActivePresentation.Slides(ActivePresentation.SlideShowWindow.View.Slide.SlideIndex).Shapes _
    (ActivePresentation.Slides(ActivePresentation.SlideShowWindow.View.Slide.SlideIndex).Shapes.Count)
End Sub

Code activated by UNDO "Button" on slide in presentation mode (Code in Normal Module and an Action was added to the button (rectangle block)):

Sub DeleteLastPastedImage()
    If Not lastPastedImage Is Nothing Then
        lastPastedImage.Delete
        xCnt = zCnt
        Set lastPastedImage = Nothing ' Clear the reference
    Else
        MsgBox "No pasted image to delete."
    End If
End Sub

The following code is to change the pasting position to a new line. (Code situated on specific slide under MicroSoft PowerPoint Objects):

Private Sub cmdNewLine_Click()
    ' New Line
    xCnt = 15
    yCnt = yCnt + 70 '90
End Sub

The following code is to change the pasting position to its original position and delete all images from the area where the pasting gets done. (Code situated on specific slide under MicroSoft PowerPoint Objects):

Private Sub cmdRESET_Click()
    yCnt = 70 '90
    xCnt = 15
    DeletePicturesInAreaSS
End Sub

Sub DeletePicturesInAreaSS()
    ' This code is intended to be run from within Slide Show view.
    ' It deletes all images in the specified area of the slide, as well as images
    ' with enough height overlap with the specified area:
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer
    Dim deletedCount As Integer
    ' Define the area (in points):
    Dim areaLeft As Single: areaLeft = 0   ' X-coordinate of top-left corner
    Dim areaTop As Single: areaTop = 120   ' Y-coordinate of top-left corner
    Dim areaRight As Single: areaRight = 960   ' X-coordinate of bottom-right corner
    Dim areaBottom As Single: areaBottom = 540   ' Y-coordinate of bottom-right corner
    ' Reference the current slide in Slide Show view
    Set sld = SlideShowWindows(1).View.Slide
    deletedCount = 0
    ' Loop backwards to safely delete shapes:
    For i = sld.Shapes.Count To 1 Step -1
        Set shp = sld.Shapes(i)
        If shp.Type = msoPicture Or shp.Type = msoAutoShape Then
            ' Calculate the right and bottom edges of the shape
            Dim shpRight As Single: shpRight = shp.Left + shp.Width
            Dim shpBottom As Single: shpBottom = shp.Top + shp.Height
            If shp.Top >= areaTop Then
                shp.Delete
                deletedCount = deletedCount + 1
            ElseIf (shpBottom - areaTop) / (shpBottom - shp.Top) >= 0.8 Then
                shp.Delete
                deletedCount = deletedCount + 1
            End If
        End If
    Next i
    ' If deletedCount = 0 Then
        '    MsgBox "No pictures found in the specified area.", vbInformation
    ' Else
        '    MsgBox deletedCount & " picture(s) deleted from the area.", vbInformation
    ' End If
End Sub

The following code is to change the pasting X-position only to its original position. (Code situated on specific slide under MicroSoft PowerPoint Objects):

Private Sub cmdResetX_Click()
xCnt = 15
End Sub
[/code]