Question

我正在编写一个报表生成器，它会打印从多页工作簿生成的大型数组，我需要将工作表名称垂直显示以适应数据。我看过很多关于使用Rows（）的帖子。自动调整，理论上很好，但是这不适用于具有垂直文本的单元格的行。像这样：

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

这不起作用。我已经找到了找到给定字体/格式的字符串的输出长度（即不是Len（））并找不到任何有价值的方法，我已经找到了查找给定单元格是否有更长文本的方法比单元格还要空洞。

作为最后的努力，我想我可以首先将所有值输入到空白页中，不用垂直定向，自动调整所有列，测试每个列的宽度，找到最大宽度，然后一旦我垂直定向，就将它用于新的行高，但这对于应该是简单的代码行来说似乎是迷宫和烦人的。

有没有人有任何想法？

Answer 1

如何首先自动调整列，然后在旋转文本之前测量ColumnWidth，然后将rowHeight设置为调整屏幕分辨率的值？

类似的东西：

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

显然，如果要在不同分辨率的屏幕上显示结果，这个解决方案并不理想，但它可以在具有特定分辨率的屏幕上很好地工作。

Answer 2

我有一个脑波，并知道如何至少半简单地做到这一点。关键是标准的新工作表具有64像素高，20像素宽的单元格。因此，此代码打开一个新工作表，查找其中一个单元格的列宽和行高，并使用它来查找行高和列高之间的比率。 这甚至适用于不同尺寸的显示器。

此外，如果您将所需的所有标签放在一列中，然后自动调整该列，您将获得列所需的最大宽度，而无需查找所有列的最大值。

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

我希望这最终对某人有用。我当然花了很多时间来解决这个问题：）

-Travis

如何自动调整包含垂直文本的行？

2 个答案: