View Single Post
 
Old 06-21-2015, 12:14 AM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,142
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

It is not exactly clear what you are doing here. The macro will address the table the cursor is in. If you want to process a variety of tables, you need to loop through the tables, e.g.
Code:
Sub ProcessTables()
Dim oTable As Table
Dim oRng As Range
    For Each oTable In ActiveDocument.Tables
        Set oRng = oTable.Cell(Row:=3, Column:=3).Range
        oRng.End = oRng.End - 1 'Omit the cell end character
        If Len(oRng) > 40 Then
            oRng.Select
            MsgBox "40 Char Description: Exceeded Character Limit of 40 " & "(" & Len(oRng) & ")"
            oRng.Text = Left(oRng.Text, 40) 'trim to 40 characters
        End If
    Next oTable
End Sub
or if users are tabbing through tables, the following macro will evaluate Row 3, column 3 of the current table as you tab out of the cell

Code:
Option Explicit
Sub NextCell()
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
Dim iCol As Long
Dim iRow As Long
    Set oTable = Selection.Tables(1)
    iCol = oTable.Columns.Count
    iRow = oTable.Rows.Count
    Set oCell = Selection.Cells(1)
    Set oRng = oCell.Range
    oRng.Collapse 1
    If iCol >= 3 And iRow >= 3 Then
        If oCell.Range.InRange(oTable.Cell(3, 3).Range) Then
            oRng.End = oCell.Range.End - 1
            If Len(oRng) > 40 Then
                MsgBox "40 Char Description: Exceeded Character Limit of 40 " & "(" & Len(oRng) & ")"
                oRng.Text = Left(oRng.Text, 40) 'trim to 40 characters
            Else
                If Not oRng.InRange(oTable.Cell(iRow, iCol).Range) Then
                    Selection.Cells(1).Next.Select
                    Selection.Collapse 1
                Else
                    oTable.Rows.Add
                    Selection.Cells(1).Next.Select
                    Selection.Collapse 1
                End If
            End If
        End If
    Else
        If Not oRng.InRange(oTable.Cell(iRow, iCol).Range) Then
            Selection.Cells(1).Next.Select
            Selection.Collapse 1
        Else
            oTable.Rows.Add
            Selection.Cells(1).Next.Select
            Selection.Collapse 1
        End If
    End If
End Sub
__________________
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