Auto Row Height

[Phil]

I would like to make a macro that would set each row height based on:
the current width setting of the Name column, and
the length of text in the Name field for each row,

(A future enhancement would consider level of indent and text size,
but for now it is not necessary)

For instance for a Name column width of 80, the following would be
set:

Len(Name) Row Height
0- 80 1
81-160 2
161-240 3
241-320 4

321 5

I will happily accept complete code, or just a few references to what
objects I should be working with.

Thanks,
Phil Bornemeier

 

[Phil]

Public Sub AutoRowHeightSet()
' Phil B
' Sets row height for MSP 2000 and later based on the length of the Name field
' and the level of indent in use. As soon as I find a way to read the column
' width, I will incorporate that. With the intNameColumnWidth = 80, a Name
' column of 60 and Arial 8 font, this works pretty good.

' 20030905 Version: Original

Dim t As Task
Dim intNameColumnWidth As Integer
Dim intIndentWidth As Integer
intNameColumnWidth = 80
intIndentWidth = 5
For Each t In ActiveProject.Tasks
EditGoTo t.ID: SelectRow

Select Case Len(ActiveProject.Tasks(t.ID).Name)
Case Is < intNameColumnWidth - intIndentWidth * _
(ActiveProject.Tasks(5).OutlineLevel - 1)
SetRowHeight unit:=1, Rows:=t.ID, useuniqueid:=False
Case Is < (2 * intNameColumnWidth) - intIndentWidth * _
(ActiveProject.Tasks(5).OutlineLevel - 1)
SetRowHeight unit:=2, Rows:=t.ID, useuniqueid:=False
Case Is < (3 * intNameColumnWidth) - intIndentWidth * _
(ActiveProject.Tasks(5).OutlineLevel - 1)
SetRowHeight unit:=3, Rows:=t.ID, useuniqueid:=False
Case Is < (4 * intNameColumnWidth) - intIndentWidth * _
(ActiveProject.Tasks(5).OutlineLevel - 1)
SetRowHeight unit:=4, Rows:=t.ID, useuniqueid:=False
Case Else
SetRowHeight unit:=5, Rows:=t.ID, useuniqueid:=False
End Select

Next

Set t = Nothing

End Sub

 

[Phil]

A slightly better version:

Public Sub AutoRowHeightSet()
' Sets row height for MSP 2000 and later based on the width of the active
' window, length of the Name field and the level of indent in use.
' ----------------------------
' Phil Bornemeier 06 Sep 2003
' ----------------------------
' Prior to running this macro:
' 1) Set the ActiveProject window width to display only that column
'
' Be sure to take into account the width of the row selector by making
' the window as much narrower than the Name column as the row selector
' column is wide. The RSC is also measured as part of the active window
'
' The constants set in this code seem to work well for Arial 8 font
' You may have to vary them if you use other fonts.
' ----------------------------------
Dim t As Task
Dim lngColumnWidth As Long 'Width of the selected column in characters
Dim lngIndentWidth As Long 'Width of the indent level in characters
Dim lngEffectiveLineLength 'Width of line in characters based on
' column setting and indent level
Dim intRowHeight As Integer 'Number of rows to set task height to
Dim intLevel As Integer 'Used to apply lngIndentWidth if Name
' field is selected
Dim lngCharPerInch 'Average numbers of characters per inch
' for the column selected
Dim lngPointsInAvgCharWidth As Long 'Number of Points in the average
' character width
Dim intResponse As Integer 'For msgbox answers

ActiveWindow.WindowState = pjNormal ' Restore the window
intResponse = MsgBox("If the active window is not set to the width of the " & _
"name column, click cancel and resize it before running this macro.", _
vbOKCancel, "Window width = Name column width ?")
If intResponse = 1 Then

'The following values seem to work well with Arial 8 font:

' Average number of characters in the width of an indent
lngIndentWidth = 4
lngPointsInAvgCharWidth = 4.5

'Characters per line for given column / window width
lngColumnWidth = Int(ActiveProject.Windows.ActiveWindow.Width / _
lngPointsInAvgCharWidth)

' Only using Name now - This section not yet used ---------------+
If ActiveSelection.FieldIDList(1) = 188743694 Then ' |
'Name column is selected' |
intLevel = 1 ' Account for indent level ' |
Else ' |
intLevel = 0 ' Not Name column, ignore indent level ' |
End If ' |
intLevel = 1 ' |
' ---------------------------------------------------------------+

For Each t In ActiveProject.Tasks
EditGoTo t.ID: SelectRow

lngEffectiveLineLength = lngColumnWidth - lngIndentWidth * _
(ActiveProject.Tasks(t.ID).OutlineLevel - 1)

'next line for troubleshooting only. Comment out before release -+
't.Text1 = _
Str(Len(ActiveProject.Tasks(t.ID).Name)) & " " & _
lngEffectiveLineLength & " " & _
Str(lngColumnWidth) ' |
' ----------------------------------------------------------------+

If lngEffectiveLineLength < 10 Then lngEffectiveLineLength = 10
intRowHeight = Int(Len(ActiveProject.Tasks(t.ID).Name) / _
(lngEffectiveLineLength + 0.1)) + 1
If intRowHeight > 20 Then intRowHeight = 20 ' 20 is max value

SetRowHeight Unit:=intRowHeight, Rows:=t.ID, useuniqueid:=False

Next

Set t = Nothing

ActiveWindow.WindowState = pjMaximized ' Restore the window

End If ' User clicked Cancel

End Sub