• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 307
  • Last Modified:

Resize cells to height of both

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
0
rtod2
Asked:
rtod2
  • 8
  • 7
  • 2
1 Solution
 
Curt LindstromCommented:
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
0
 
rtod2Author Commented:
Cool ok, looking...  Will it prevent more than one picture per cell?
0
 
Curt LindstromCommented:
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
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
rtod2Author Commented:
It looks like it is allowing multiple heights for cells.  Is it not supposed to?
0
 
rtod2Author 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.
0
 
Curt LindstromCommented:
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
0
 
Curt LindstromCommented:
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

0
 
rtod2Author 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.
0
 
Curt LindstromCommented:
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
0
 
Curt LindstromCommented:
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
0
 
rtod2Author 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.
0
 
rtod2Author Commented:
I'll pass all your comments on to her so she can read what is said here.  Thanks for all the help.
0
 
Saqib Husain, SyedEngineerCommented:
Try this macro.

This macro will

move pictures back which have drifted from their own row
align pictures with the left and top edges of the cell
stop where there are more than 2 pictures in a row
adjust height of row to the larger picture size
if a picture is too short (less than 5px) it will resize it to the current row height

Saqib
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
        ph = 0
        np = 0
        picfound = False
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Row = rw.Row Then
                np = np + 1: If np > 2 Then rw.Select: MsgBox ("This row has more than 2 pics"): End
                shp.Select
                If WorksheetFunction.CountA(rw) > 0 Then
                    shp.Top = rw.Offset(1, 0).Top
                Else
                    picfound = True
                    shp.Top = rw.Top
                    If shp.Left < 200 Then shp.Left = Cells(1, 2).Left Else shp.Left = Cells(1, 5).Left
                    If shp.Height < 5 Then shp.Height = shp.TopLeftCell.Height
                    If shp.Height > ph Then ph = shp.Height
                    'Exit For
                End If
            End If
        Next shp
                rw.RowHeight = ph
        If Not picfound Then rw.Select: rw.AutoFit
    Next rw
End Sub

Open in new window

0
 
Curt LindstromCommented:
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
0
 
rtod2Author 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
0
 
Saqib Husain, SyedEngineerCommented:
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
0
 
rtod2Author Commented:
Unbelievable stuff!
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 8
  • 7
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now