Page 1 of 2 12 LastLast
Results 1 to 10 of 17

Thread: Resize and Move to Fit
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    May 2018
    Posts
    103
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Resize and Move to Fit

    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?

  2. #2
    Board Regular
    Join Date
    Mar 2015
    Posts
    4,055
    Post Thanks / Like
    Mentioned
    73 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Resize and Move to Fit

    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

  3. #3
    Board Regular
    Join Date
    May 2018
    Posts
    103
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Resize and Move to Fit

    Quote Originally Posted by Yongle View Post
    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?

  4. #4
    Board Regular
    Join Date
    Mar 2015
    Posts
    4,055
    Post Thanks / Like
    Mentioned
    73 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Resize and Move to Fit

    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 by Yongle; Mar 3rd, 2019 at 02:03 PM.

  5. #5
    Board Regular
    Join Date
    May 2018
    Posts
    103
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Resize and Move to Fit

    Quote Originally Posted by Yongle View Post
    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.

  6. #6
    Board Regular
    Join Date
    Mar 2015
    Posts
    4,055
    Post Thanks / Like
    Mentioned
    73 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Resize and Move to Fit

    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)

  7. #7
    Board Regular
    Join Date
    May 2018
    Posts
    103
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Resize and Move to Fit

    Quote Originally Posted by Yongle View Post
    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?

  8. #8
    Board Regular
    Join Date
    Mar 2015
    Posts
    4,055
    Post Thanks / Like
    Mentioned
    73 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Resize and Move to Fit

    after teating the code, let me know what's wanted

  9. #9
    Board Regular
    Join Date
    May 2018
    Posts
    103
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Resize and Move to Fit

    Quote Originally Posted by Yongle View Post
    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!

  10. #10
    Board Regular
    Join Date
    Mar 2015
    Posts
    4,055
    Post Thanks / Like
    Mentioned
    73 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Resize and Move to Fit

    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 by Yongle; Mar 4th, 2019 at 08:14 AM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •