CODEWITHSUNDEEP
vbaexcel
Travis V
Travis V

Reputation: 11

How to autosize a row that contains vertical text?

I'm coding a report generator which prints large arrays generated from multiple-sheet workbooks, and I need to have the sheet names displayed vertically to fit the data in. I've seen lots of posts about using Rows().Autofit, which theoretically is great, but this DOES NOT WORK with rows that have cells with vertical text. Something like this:

Sub GenReport()
Dim SheetIndex as Integer
Dim NumSheets as Integer
Dim ws as Worksheet

NumSheets = Activeworkbook.Sheets.Count

Sheets.Add After:=Sheets(NumSheets)
Set ws = Sheets(NumSheets+1)

For SheetIndex = 1 to NumSheets
    With ws.Cells(4,SheetIndex + 1)
        .Value = Sheets(SheetIndex).name
        .Font.Size = 12
        .Font.Bold = True
        .Orientation = 90
    End With
Next SheetIndex

ws.Rows(4).Autofit

End Sub

This does NOT work. I've looked for ways to find the output length (i.e. not Len()) of a string for a given font/format and found nothing of value, I've looked for ways to find whether a given cell has text that is longer than the cell and similarly come up empty.

As a last ditch effort, I suppose I could start by inputting all the values into an empty sheet without orienting vertically, autosize all columns, test the width of each, find the max width, then use this for the new row height once I have oriented vertically, but this seems labyrinthine and annoying for what should be a simple line of code.

Does anyone have any ideas?

Upvotes: 1

Views: 894

Answers (2)

Travis V
Travis V

Reputation: 11

I had a brainwave, and know how to do this at least semi-simply. The key is that a standard new sheet has cells that are 64 pixels tall by 20 pixels wide. So, this code opens a new sheet, finds the column width and row height of one of the cells, and uses this to find the ratio between row and column height. This will even work on different sized monitors.

In addition, if you put all the labels you want in a column, then autosize that column, you get the maximum width needed for a column without having to muck about with finding the max of all columns used.

Sub GenReport()
Dim SheetIndex as Integer
Dim NumSheets as Integer
Dim ws as Worksheet
Dim rh as double
Dim cw as double
Dim Ratio As Double

NumSheets = Activeworkbook.Sheets.Count

Sheets.Add After:=Sheets(NumSheets)
Set ws = Sheets(NumSheets+1)

With Cells(1, 1)
    cw = .ColumnWidth
    rh = .RowHeight
End With

'Since 64/20 = 3.2, this gives you the exact ratio between row width units and column width units
Ratio = 3.2 * rh / cw

For SheetIndex = 1 to NumSheets

'These cells are just to autosize to find the max width, they will be deleted momentarily.
    With ws.Cells(SheetIndex,1)
        .Value = Sheets(SheetIndex).name
        .Font.Size = 12
        .Font.Bold = True
    End With

'The actual labels I want to keep
    With ws.Cells(4,SheetIndex + 2)
        .Value = Sheets(SheetIndex).name
        .Font.Size = 12
        .Font.Bold = True
        .Orientation = 90
    End With
Next SheetIndex

Columns(1).Autofit
Rows(4).RowHeight = Ratio * Columns(1).ColumnWidth

Application.DisplayAlerts = False
Columns(1).Delete
Application.DisplayAlerts = True

End Sub

I hope that this ends up being useful for someone. I certainly spent what could have been a very productive day figuring this out :)

-Travis

Upvotes: 0

Miqi180
Miqi180

Reputation: 1691

How about autofitting the column first and then measuring the ColumnWidth before rotating the text and then setting the rowHeight to that value adjusting for screen resolution?

Something like:

Dim cw As Long

     With ActiveSheet.Cells(4, 4)
            .Value = Sheets(SheetIndex).Name
            .Font.Size = 12
            .Font.Bold = True
            .EntireColumn.AutoFit
            cw = .EntireColumn.ColumnWidth
            .Orientation = 90
            .EntireRow.RowHeight = cw * 22 ' set conversion factor according to screen resolution
    End With

Obviously, this solution is not ideal if the results are to be displayed on screens with different resolutions, but it will work nicely on screens with that particular resolution.

Upvotes: 0

Related Questions