Custom script to auto-fit all columns and rows... please provide your input! RRS feed

  • Question

  • Hello guys, I'm getting into VBA for Project and have written some utilities to make the Project task grids work more like Excel. One thing I noticed is that there is no "Auto-fit all columns" feature, so I wrote one.  It is shown below.  The basic idea is that it first auto-fits each column and then it sets the row height to 1 unit because project doesn't automatically shrink the row height if the text stops wrapping. 

    Sub AutoSizeAllColumns()
        Dim i As Integer
        Dim T As Task
        ' first get reference to view that is currently selected
        Dim tempView As ViewSingle
        Set tempView = Application.ActiveProject.ViewsSingle(Application.ActiveProject.CurrentView)
        If Not tempView Is Nothing Then
            ' now get reference to table on the view
            Dim tempTable As Table
            Set tempTable = tempView.Table
            If Not tempTable Is Nothing Then
                Application.ScreenUpdating = False
                ' now run ColumnBestFit loop from 1 to # of fields to autofit them.
                For i = 1 To tempTable.TableFields.Count
                    ColumnBestFit Column:=i
                Next i
                ' now fix row heights to 1 line
                For Each T In ActiveProject.Tasks
                    SetRowHeight unit:=1, Rows:=T.UniqueID, useuniqueID:=True
                Next T
                Application.ScreenUpdating = True
            End If
        End If
    End Sub

    Overall, this script definitely does the job.  However, it's slow on projects with over 100 tasks (which is pretty common) as the SetRowHeight command is very inefficient.  I've tried a few tricks to speed it up, like ScreenUpdating=False, which helped a bit but the routine is still noticeably slow.  Without the SetRowHeight part, it's very fast, but then it leaves those rows that were multiple lines in height too tall once the columns are auto-fitted.  

    Any ideas?  I was thinking maybe I could speed it up by first determining if each row needs to be resized before resizing it.  I.e. if there is any way to get the current height of a row and only run SetRowHeight if the current height is > 1.  I haven't found any way to do that, though.  I don't see any way to access the "row" at all.  Through the table object you can access the TableFields collection, but the only way I can see to access the rows is via the Task object, which doesn't tell you anything about the row properties.  

    Thanks for your input.  Maybe my script will help someone else out there as well!


    Wednesday, February 1, 2012 8:03 PM

All replies

  • Hi Rocky,

    Try following alternative:

    SetRowHeight unit:=1, Rows:="All", useuniqueID:=False
    'instead of 
    For Each T In ActiveProject.Tasks
      SetRowHeight unit:=1, Rows:=T.UniqueID, useuniqueID:=True
    Next T

    I tried it with 1000 rows and it took less than one second...


    PS: your first point for your "helpful" post ;)
    Tuesday, April 10, 2012 6:24 PM