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

我正在编写一个报表生成器，它打印从多张工作簿生成的大型数组，我需要垂直显示表名以适应数据。我已经看到很多关于使用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 

这是行不通的。 我寻找的方法来find一个给定的字体/格式的string的输出长度（即不是Len（）），并没有发现任何价值，我寻找方法来find一个给定的单元格是否有更长的文本比单元格同样空洞。

作为最后一个努力，我想我可以开始通过input所有的值到一个空的工作表没有垂直的方向，autosize所有列，testing每个的宽度，find最大宽度，然后用这个新的行高一旦我有垂直方向，但这似乎是迷宫，讨厌什么应该是一个简单的代码行。

有没有人有任何想法？

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 

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

Answer 2

我有一个脑波，知道如何至less半简单地做到这一点。 关键是标准的新工作表具有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