Shrink to fit long merged name

macropod · #6 09-15-2022, 02:27 PM

That could only be happening to your second example if it spanned more than one line. The code specifically tests how many lines the content in each cell spans. Perhaps you have an extraneous paragraph break/line break there? Or are you doing this in the mailmerge main document instead of to the output?

For a generalised mailmerge solution, you might use something like:

Code:

Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim Tbl As Table, Cll As Cell, Par As Paragraph, sCllWdth As Single, sParWdth As Single
With ActiveDocument
  With .Tables(1).Cell(1, 1)
      sCllWdth = .Width - .LeftPadding - .RightPadding
      With .Range.Paragraphs(1)
        sCllWdth = sCllWdth - .LeftIndent - .RightIndent
      End With
    End With
  End With
  .MailMerge.Execute
End With
With ActiveDocument
  For Each Tbl In .Tables
    For Each Cll In Tbl.Range.Cells
      If Len(Cll.Range) > 2 Then
        For Each Par In Cll.Range.Paragraphs
          With Par.Range
            sParWdth = .Characters.Last.Previous.Information(wdHorizontalPositionRelativeToPage) _
              - .Characters.First.Information(wdHorizontalPositionRelativeToPage)
            If sParWdth > sCllWdth Then .FitTextWidth = sCllWdth
            If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) > _
              .Characters.First.Information(wdVerticalPositionRelativeToPage) Then .FitTextWidth = sCllWdth
          End With
        Next
      End If
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub

The above code processes cell content by paragraph, rather than just the whole cell. Not only does this code cater for wrapped lines, it also caters for cells whose content exceeds the cell width where someone has turned line-wrapping off.

The only caveat is that every intended new line in the cells is created by a paragraph break rather than a manual line break.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to unmerge all merged cell and fill them with the merged values?	Bumba	Excel Programming	1	11-10-2019 11:36 AM
Why my Docm file does not shrink in size?	eduzs	Word VBA	3	09-16-2018 04:13 AM
Does Word automatically shrink graphics?	jrasicmark	Drawing and Graphics	1	05-06-2014 04:38 PM
Custom Animation: Faded Shrink?	Dingeling	PowerPoint	2	12-14-2011 02:14 AM
Possible to shrink .DOC file?	uoficowboy	Word	0	06-09-2010 10:13 AM