View Single Post
 
Old 08-12-2016, 04:28 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,144
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Not only does your document have three tables, but each of those tables has two columns. The cell in the second column contains '0' formatted with 2 point Arial font?

It appears from your comments that you want to reduce the font size of the long paragraph in the first column until it fits on one line? That being the case the following macro will do the job.

Code:
Option Explicit

Sub ShrinkParagraphText()
Dim oTable As Table
Dim oRow As Row
Dim oCell As Cell
Dim oRng As Range
Dim oPara As Paragraph
    For Each oTable In ActiveDocument.Tables
        For Each oRow In oTable.Rows
            Set oCell = oRow.Cells(1)
            Set oRng = oCell.Range
            oRng.End = oRng.Paragraphs(1).Range.End - 1
            Do While NumLines(oRng) > 1
                oRng.Font.Shrink
            Loop
        Next oRow
    Next oTable
lbl_Exit:
    Set oTable = Nothing
    Set oRow = Nothing
    Set oCell = Nothing
    Set oRng = Nothing
    Set oPara = Nothing
    Exit Sub
End Sub

Function NumLines(rng As Range) As Long
Const wdStatisticLines As Long = 1
    NumLines = rng.ComputeStatistics(wdStatisticLines)
lbl_Exit:
    Exit Function
End Function
This will however result in some very tiny text in the example document.

If you want to mail merge into a table and create a new row for each record, then create a single row table. Put your merge fields in the cells of that row and set the merge type to 'Directory'. Merge to a new document.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote