Resize and Move to Fit

Pestomania

Board Regular
Joined
May 30, 2018
Messages
105
Hi everyone,

I'm not sure if this is even possible but it would be awesome!!

Is there a vba code to select all pictures and textboxes *only* and rearrange, resize to make all of them fit on the Excel sheet without overlay of each other or overlay of text in column A?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,640
Office Version
365
Platform
Windows
This does what you asked for, but is unlikely to yield exact desired result without amening to match your own requirements
Test on a COPY of your workbook!
Code:
Sub reArrange()
    Dim Shp As Shape, L As Double, T As Double
    With ActiveSheet
        L = .Range("A1").Left + .Range("A1").Width
        T = .Range("A1").Top
        For Each Shp In .Shapes
            With Shp
                .Top = T
                .Left = L
                .Width = 100
                L = L + 100
            End With
        Next Shp
    End With
End Sub
Let us know if you need further help - need more details if you want to control where the objects are placed
 

Pestomania

Board Regular
Joined
May 30, 2018
Messages
105
This does what you asked for, but is unlikely to yield exact desired result without amening to match your own requirements
Test on a COPY of your workbook!
Code:
Sub reArrange()
    Dim Shp As Shape, L As Double, T As Double
    With ActiveSheet
        L = .Range("A1").Left + .Range("A1").Width
        T = .Range("A1").Top
        For Each Shp In .Shapes
            With Shp
                .Top = T
                .Left = L
                .Width = 100
                L = L + 100
            End With
        Next Shp
    End With
End Sub
Let us know if you need further help - need more details if you want to control where the objects are placed
Hi Yongle! Wow thank you so much! I am going to test this immediately when I get to work tomorrow. The only thing I would like to look at is if there is a way to determine which row the last text in column A is and have it fill space below that, but place nothing above that?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,640
Office Version
365
Platform
Windows
The only thing I would like to look at is if there is a way to determine which row the last text in column A is and have it fill space below that, but place nothing above that?
For simplicity the code moves ALL shapes (not only textboxes and pictures)
- are there any other shapes on the sheet?

Code:
Sub reArrange()
    Dim Shp As Shape, L As Double, T As Double
    With ActiveSheet
        With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            L = .Left + .Width
            T = .Top
        End With
        For Each Shp In .Shapes
            With Shp
                .Top = T
                .Left = L
                .Width = 100
                L = L + 100
            End With
        Next Shp
    End With
End Sub
 
Last edited:

Pestomania

Board Regular
Joined
May 30, 2018
Messages
105
For simplicity the code moves ALL shapes (not only textboxes and pictures)
- are there any other shapes on the sheet?

Code:
Sub reArrange()
    Dim Shp As Shape, L As Double, T As Double
    With ActiveSheet
        With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            L = .Left + .Width
            T = .Top
        End With
        For Each Shp In .Shapes
            With Shp
                .Top = T
                .Left = L
                .Width = 100
                L = L + 100
            End With
        Next Shp
    End With
End Sub
Hi, I am okay with it moving everything. I would personally love to see it determine where the last used row in column "A" is and fill the space below with white and rearrange the images on top of that.

But really, I just don't want it to cover anything that has column "A" filled.
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,640
Office Version
365
Platform
Windows
If you want the first shape in column A, then when L is first calculated, amend the code in post#4 to
Code:
L = .Left
(ie do not add the width of the first column into the calculation)
 

Pestomania

Board Regular
Joined
May 30, 2018
Messages
105
If you want the first shape in column A, then when L is first calculated, amend the code in post#4 to
Code:
L = .Left
(ie do not add the width of the first column into the calculation)
Hi. I'm sorry. I am okay with the image starting in any column. There will be text in column "A". The images should not cover anything that is in column A. So it would need to determine what the last row in column A is (ie. Row 10 is the last used), so starting in row 11, start to fill.

Also, the bottom of the page in excel is row 22, is there a way to say not to go further than that?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,640
Office Version
365
Platform
Windows
after teating the code, let me know what's wanted
 

Pestomania

Board Regular
Joined
May 30, 2018
Messages
105
after teating the code, let me know what's wanted
Hi Yongle. I have tested the code. It places everything side by side which works for me, but the images are tiny now. I placed large images and now they are 1.2" tall.

And it works perfect for the rows.count! Only thing is that I would need it to stop the height at the print area if possible.

Thank you. You are amazing!
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,640
Office Version
365
Platform
Windows
but the images are tiny now
You said you wanted to resize them and this is the line that is doing it
Code:
.Width = 100
How do you want to resize?
- are images to be treated same as textboxes etc?
Are all images named "Picture " followed by a number?
Are all TextBoxes named "TextBox" followed by a number?
 
Last edited:

Forum statistics

Threads
1,081,661
Messages
5,360,338
Members
400,581
Latest member
Eskimo

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top