Change The Dimensions of Second Shape on the Selected Slide Only

laith93 · #1 12-03-2023, 02:12 PM

Hi,
I made this macro to change the dimension of the second shape in each slide

Code:

Sub ChangeDimensionsOfSecondShape()
    Dim slideIndex As Integer
    Dim shapeIndex As Integer
    Dim newWidth As Integer
    Dim newHeight As Integer
    
    ' Set the new dimensions
    newWidth = 100
    newHeight = 50
    
'     .Height = 428
' .Width = 930
' .Left = 15
' .Top = 77
    ' Loop through all slides
    For slideIndex = 1 To ActivePresentation.Slides.Count
        ' Check if there are at least two shapes on the slide
        If ActivePresentation.Slides(slideIndex).Shapes.Count >= 2 Then
            ' Get the second shape on the slide
            shapeIndex = 2 ' Change this index if the second shape is not the desired one
            With ActivePresentation.Slides(slideIndex).Shapes(shapeIndex)
                ' Change the dimensions of the shape
                .Width = 930
                .Height = 428
                .Left = 15
                .Top = 77
            End With
        End If
    Next slideIndex
End Sub

so how to edit it to change the dimension of the second shape on the selected slide only
Thanks

JohnWilson · #2 12-04-2023, 06:16 AM

Are you intending to run the code in Show mode or Normal Edit mode? The code would be different.
This code will only work in Edit Mode

Code:

Sub ChangeDimensionsOfSecondShape()
    Dim osld As Slide
    Dim shapeIndex As Integer
    Dim newWidth As Integer
    Dim newHeight As Integer
    'Edit mode only!
    ' Set the new dimensions
    newWidth = 100
    newHeight = 50
'set osld to currenht slide
Set osld = ActiveWindow.Selection.SlideRange(1)
        ' Check if there are at least two shapes on the slide
        If osld.Shapes.Count >= 2 Then
            ' Get the second shape on the slide
            shapeIndex = 2 ' Change this index if the second shape is not the desired one
            With osld.Shapes(shapeIndex)
                ' Change the dimensions of the shape
                .Width = 930
                .Height = 428
                .Left = 15
                .Top = 77
            End With
        End If
End Sub

laith93 · #3 12-04-2023, 07:11 AM

Quote:

Originally Posted by JohnWilson

Are you intending to run the code in Show mode or Normal Edit mode? The code would be different.
This code will only work in Edit Mode

Thanks so much, Mr. John
I always working in Normal edit mode

Mr. Jhon,

Code:

If osld.Shapes.Count >= 2 Then

The code change the dimension of first shape, but when I change 2 to 1, it's change the dimension of second shape, so I think there is an error (Iam shocked), because my another code which run for all slides, it works true (1 for first shape, 2 for second shape and so).
So what is the problem with our editing code?

Code:

If osld.Shapes.Count >= 2 Then

Thanks

JohnWilson · #4 12-04-2023, 07:32 AM

The code works fine here but why not just change the selected shape?

Code:

Sub ChangeDimensionsOfSelectedShape()
    Dim oshp   As Shape
    Dim newWidth As Integer
    Dim newHeight As Integer

    ' Set the new dimensions
    newWidth = 100 ' these do nothing
    newHeight = 50 ' these do nothing

    'set osld to currenht slide
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    With oshp
        ' Change the dimensions of the shape
        .Width = 930
        .Height = 428
        .Left = 15
        .Top = 77
    End With
End Sub

laith93 · #5 12-04-2023, 08:31 AM

Quote:

Originally Posted by JohnWilson

The code works fine here but why not just change the selected shape?

Excuse me Mr. Jhon
This message appears
75.png
Just for clarification, I select the slide and run the code.

JohnWilson · #6 12-05-2023, 01:21 AM

Did you select a shape?

laith93 · #7 12-05-2023, 04:55 AM

Quote:

Originally Posted by JohnWilson

Did you select a shape?

No, I don't want to select the shape
I want just select the slide and run the code.
However, Mr. Jhon, I think the problem is with my file, because I made a new file and run your previous code and works perfectly

Code:

Sub ChangeDimensionsOfSecondShape()
    Dim osld As Slide
    Dim shapeIndex As Integer
    Dim newWidth As Integer
    Dim newHeight As Integer
    'Edit mode only!
    ' Set the new dimensions
    newWidth = 100
    newHeight = 50
'set osld to currenht slide
Set osld = ActiveWindow.Selection.SlideRange(1)
        ' Check if there are at least two shapes on the slide
        If osld.Shapes.Count >= 2 Then
            ' Get the second shape on the slide
            shapeIndex = 2 ' Change this index if the second shape is not the desired one
            With osld.Shapes(shapeIndex)
                ' Change the dimensions of the shape
                .Width = 930
                .Height = 428
                .Left = 15
                .Top = 77
            End With
        End If
End Sub

Thanks

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to change the internal wall dimensions for T room	mummy	Visio	0	06-15-2017 09:23 PM
How to change size / shape of a shape in a stencil	tomgoodell	Visio	1	06-30-2016 04:40 AM
Dimensions of a Table Created in Word 2013 Change when saved in Word 2016	PKW57	Word Tables	2	05-26-2016 05:15 AM
Word - Resize image to specified selected cells' dimensions	FaizanRoshan	Word VBA	7	10-18-2015 03:34 PM
Determine if a shape is selected	Byron Polk	Word VBA	2	08-06-2014 02:26 AM