We help IT Professionals succeed at work.

Check out our new AWS podcast with Certified Expert, Phil Phillips! Listen to "How to Execute a Seamless AWS Migration" on EE or on your favorite podcast platform. Listen Now

x

Resize cells to height of both

Medium Priority
320 Views
Last Modified: 2012-05-11
I would like to re-size the cells to fit the height of both the text and the pictures.

For pictures, I am looking to have only pictures inside those cells.
For text, I am looking to have only text within those cells.

The file is attached and assistance is still much needed.
tosstudies-6.11.xlsm
Comment
Watch Question

Try changing the Sub "auto_Height" to this:
 
Sub auto_Height()
'old title adjstPiclessRw()
'This is designed to make height fit the contents without adversely affecting the pictures'
    For Each Rw In ActiveSheet.UsedRange.Rows
        picfound = False
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Row = Rw.Row Then
                picfound = True
                shp.Height = shp.TopLeftCell.Height
                Exit For
            End If
        Next shp
        DoEvents
        If Not picfound Then Rw.Select: Rw.AutoFit
    Next Rw
End Sub

Open in new window

The sub now includes
shp.Height = shp.TopLeftCell.Height
which was  suggested by Saqib previously.

Note that all pictures will be resized to the row height of the row that the picture has been attached to.

Curt

Author

Commented:
Cool ok, looking...  Will it prevent more than one picture per cell?
It will prevent having more than one picture per cell and row if you want a different height of the pictures.
You can only have one height of a cell :-)
Cheers,
Curt

Author

Commented:
It looks like it is allowing multiple heights for cells.  Is it not supposed to?

Author

Commented:
Thanks for the help.  This has not been an easy one.

It did a bunch of this kind of stuff >> http://screencast.com/t/i7nOG9Ze where it made some of the pictures tiny.
What I mean is that you can only have one height of a row which means that all cells on that row will end up the same height. The rows where the pictures are attached to remains untouched but the pictures are re-sized to fit the height of the row. The height is determined by the first picture found on the row.

The picture in http://screencast.com/t/i7nOG9Ze is attached to row 681 and is therefore re-sized to the height of row 681. The code is re-sizing the pictures to the same height as the row they are attached to.

Curt
If you don't know which row your pictures are attached to, you can use this little macro to get the locations listed on a new sheet.

Curt
Sub Pictures_Found()
    Dim ws1 As Worksheet

    Set ws1 = Sheets.Add
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Pictures").Delete
    Application.DisplayAlerts = True
    ws1.Name = "Pictures"
    On Error GoTo 0
    i = 1
    Cells(i, 1) = "Row"
    Cells(i, 2) = "Picture"
    With ws1
        Worksheets("Studies").Activate
        For Each Shp In ActiveSheet.Shapes
            i = i + 1
            .Cells(i, 1) = Shp.TopLeftCell.Row
            .Cells(i, 2) = Shp.Name
        Next Shp
    End With
End Sub

Open in new window

Author

Commented:
I can see which ones they are attached to.  I don't want the first macro posted to shrink the size of the pictures.
It's very hard to see which rows the pictures are attached to just by looking at them. Try this macro and I think you will find that some pictures are not attached to the row you think they are attached to.

For example: Look at picture 40 and 277. They both looks like they are attached to row 112. Picture 40 is attached to row 112 but picture 277 is actually attached to row 111!

This new macro may put things in to a different light. Note also the 3rd column "Order found" which shows in which order Excel found the shapes.
 
Sub Pictures_Found()
    Dim ws1 As Worksheet

    Set ws1 = Sheets.Add
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Pictures").Delete
    Application.DisplayAlerts = True
    ws1.Name = "Pictures"
    On Error GoTo 0
    i = 1
    Cells(i, 1) = "Row"
    Cells(i, 2) = "Picture"
    Cells(i, 3) = "Order found"
    With ws1
        Worksheets("Studies").Activate
        For Each Shp In ActiveSheet.Shapes
            i = i + 1
            .Cells(i, 1) = Shp.TopLeftCell.Row
            .Cells(i, 2) = Shp.Name
            .Cells(i, 3) = i - 1
        Next Shp
        .Columns.AutoFit

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        With .Sort
            .SetRange Range("A2:C505")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Activate
        Range("A1").Select

    End With
End Sub

Open in new window

So as you can see, your problems will not be solved by simply adjusting the row heights to the picture heights.

Curt
I have attached the results from running the Pictures_Found macro. I have highlighted all rows where you may have pictures attached to the wrong rows. As you can see there are quite a number of pictures which are attached to the "wrong" rows.

You must fix this before attempting to run any macros to adjust picture heights or row heights. VBA  code can achieve a lot of things but it needs some guide lines to work from.

Cheers,
Curt
Picture-Rows.xlsx

Author

Commented:
I have Mischelle on this one.  She is pretty new to all this but I have introduced her to the issue.  Since she put together the sheet to begin with, she is probably going to have the most luck resolving the issues with it.

Author

Commented:
I'll pass all your comments on to her so she can read what is said here.  Thanks for all the help.
Engineer
CERTIFIED EXPERT
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION
Ted,

It looks like you have around 20 rows which have 3 pictures attached. I assume there should only be 2 pictures.

1. Fix those rows to have only 2 pictures. You can see which ones they are in the "PictureRows" file I posted or fix them one by one when Saqib's macro stops.
2. Run Saqib's excellent macro and all rows and pictures will be adjusted correctly.

Saqib certainly found the guidelines for the VBA code to produce miracles that I couldn't find!

Curt

Author

Commented:
Awesome!!

My outsourcer did some work to get rid of unwanted pictures.  I then ran the code in post 35421727 and it worked like a charm.  I have reattached the sheet.  Note that row 5 and 8 are examples of rows that are a little bit high still for the contents they contain.  Is there any way to fix that in those and subsequent non-picture rows?
tosstudies-6.14.xlsm
Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
Ted, I am sorry but this is one of the areas where I would not be able to help you. I can only use excel's ability to resize rowheight based on the contents and excel is failing in some of them.

I suggest that you open a new question with only this issue and also include a sample file (not this 6.7MB one) which shows only a few rows which illustrate this problem. That way you may get some better response.

Saqib

Author

Commented:
Unbelievable stuff!
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.