View Single Post
 
Old 03-16-2022, 10:50 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,138
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

The code assumed a header row in the table. As your new example doesn't have a header row the first row is ignored. Change the loop to start from 1 rather than 2.
Also in your new example there are tabs already set in the second row, which conflict with the tabs set by the macro so you need to clear those tabs first. These issues are why the macro appears not to change anything.

As there may be a header row or text in the table, I have added a check function so that cells without numbers are ignored. If you don't need that you can omit the function and its call.

Code:
Sub Macro1()
Dim oTable As Table
Dim i As Integer
Dim oCell As Cell
Dim oRng As Range
Dim iPos As Integer
    If Selection.Information(wdWithInTable) = False Then
        MsgBox "Put the cursor in the table to process first!", vbCritical
        Exit Sub
    End If
    Set oTable = Selection.Tables(1)
    With oTable
        For i = 1 To .Rows.Count
            For Each oCell In .Rows(i).Cells
                iPos = oCell.Width - oCell.LeftPadding - oCell.RightPadding - 20
                Set oRng = oCell.Range
                If IsNumbered(oCell) = True Then
                    oRng.ParagraphFormat.TabStops.ClearAll
                    oRng.Collapse 1
                    oRng.MoveEndWhile Chr(32)
                    oRng.Text = ""
                    oCell.Range.ParagraphFormat.TabStops.Add _
                            Position:=iPos, _
                            Alignment:=wdAlignTabDecimal, _
                            Leader:=wdTabLeaderSpaces
                End If
            Next oCell
        Next i
    End With
    Set oTable = Nothing
    Set oCell = Nothing
    Set oRng = Nothing
End Sub

Private Function IsNumbered(oTableCell As Cell) As Boolean
Dim sValue As String
Dim oCellRng As Range
    Set oCellRng = oTableCell.Range
    oCellRng.End = oCellRng.End - 1
    sValue = Trim(oCellRng.Text)
    IsNumbered = IsNumeric(sValue)
End Function
__________________
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