🚀 go-pugleaf

I haven't needed this, but your question intrigued me so I whipped up a script.

You need to select the table before running the script (I use Ctrl-Alt-A once my cursor is inside the table). The script uses the current measurement system: see the comments for which variables to modify to affect the granularity.

It sets the width of a particular column (in this case set with the variable KeyColumn, which is currently set to column 2) to the narrowest width within whatever you set the variable SmallChange to (this can be changed easily in the script). It would be fairly easy to set it for every column, but it's more work than it's worth for a script I'm not likely to use in the near future. :)

Note that if the variable MinWidth is set to such a small width that none of the text in the topmost cell in the column will fit the the script will fail. It is currently set to "6", which in my test document is 6 picas, wide enough so that at least part of a word will fit in the topmost cell.

It's a bit kludgy, and there may well be an easier way to do it (perhaps using some way to determine the text width, but I can't find it), but this is what popped into my head:

Oh, and this is a VBScript example.



 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'              Resize Column to Fit                       
''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' 
' Note that measurement numbers are based on whatever measurement 
' system the document is set to currently, be it inches, picas, 
' or what have you. 
' Variables that use the measurement system are: 
'       MinWidth 
'       LargeChange 
'       SmallChange 
' 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'Create variables for the objects we'll be dealing with 
Dim sObject, sCell, sLines 
' 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'Create and set variables related to the column 
Dim KeyColumn, MinWidth, ColumnFlag 
' 
'Set KeyColumn to the column you want to change the size of. 
KeyColumn = 2 
' 
'Set MinWidth to the minimum width the column should ever be  
'set to. If this is set to a width so narrow that no words can 
'fit in the first cell of the column, the script will fail 
'Note that the column will never be reduced to less than this amount 
MinWidth = 6 
' 
'Set a flag to indicate whether we've touched the column yet or not 
ColumnFlag = False 
' 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'Create and set variables related to the amount of resizing 
Dim LargeChange, SmallChange 
' 
'This is the gross amount it increases the width by 
LargeChange = 1 
' 
'This is the fine amount it decreases the width by, and 
'is the closest it will get to the perfect width. Set it 
'to too small an increment and the script may take a long 
'time to run 
SmallChange = .05 
' 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'Set up the script 
Set myInDesign = CreateObject("InDesign.Application") 
Set myDocument = myInDesign.ActiveDocument 
' 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'Run through all of the objects in the table. I don't yet know how 
'to actually see a "column" object (if it can be done), so I need 
'to do it cell by cell 
For Each sObject In myInDesign.Selection 
  Select Case TypeName(sObject) 
    Case "Cell" 
      For Each sCell In sObject.Cells 
        ' 
        'Check to see if we're working with the key column 
        If sCell.ParentColumn.Index = KeyColumn Then 
          ' 
          'If we haven't touched the column, set it to its minimum width 
          If Not ColumnFlag Then 
            sCell.ParentColumn.Width = MinWidth 
            ColumnFlag = True 
          End If 
          ' 
          'If this cell has more than one line of text then increase the width 
          If sCell.TextLines.Count > 1 Then 
            ' 
            'Increase the width by one LargeChange at a time until we have one line 
            While sCell.TextLines.Count > 1 
              sCell.ParentColumn.Width = sCell.ParentColumn.Width + LargeChange 
            Wend 
            ' 
            'Decrease the width by one SmallChange at a time until we have two lines 
            While sCell.TextLines.Count < 2 and sCell.ParentColumn.Width >= MinWidth 
              sCell.ParentColumn.Width = sCell.ParentColumn.Width - SmallChange 
            Wend 
            ' 
            'Increase the width back out by one SmallChange to get it back to one line 
            sCell.ParentColumn.Width = sCell.ParentColumn.Width + SmallChange 
            ' 
          End If 
        End If 
      Next 
    'End of Case "Cell" 
  End Select 
Next