RE: Delete cell from table in Word? - Macro

["Chinell, David F (GE Indust, Security)" <David -dot- Chinell -at- GE -dot- com>]

Okay, here are some rough-n-ready macros to do the cell shuffle. I don't
know if this is the best way to get the selected cell's index etc. I go
ahead and add a row just in case, then delete it at the end if it's
empty.

I was startled to discover that the same row-test-and-delete routine
worked for both insertion and deletion routines.

It may be possible to express this as a function and combine the code.
But probably just as easy to assign them to separate commands or
keystrokes or buttons.


Sub CellInsert()

Dim objCell As Cell
Dim objRange As Range

Dim lngCount As Long
Dim lngIndex As Long

Dim I As Integer
Dim flgEmpty As Boolean

Application.ScreenUpdating = False

' Determine the selected cell's index

Set objRange = Selection.Tables(1).Range
objRange.End = Selection.Cells(1).Range.End
lngIndex = objRange.Cells.Count

' Determine the original cell count

lngCount = Selection.Tables(1).Range.Cells.Count

' Insert a row at the end of the table

Selection.Tables(1).Rows.Add

' Move downstream cells to the right

For I = lngCount To lngIndex Step -1
    Selection.Tables(1).Range.Cells(I).Range.Cut
    Selection.Tables(1).Range.Cells(I + 1).Range.Paste
Next I

' Delete the last row if empty

flgEmpty = True
Set objRange = Selection.Tables(1).Rows.Last.Range
For I = 1 To objRange.Cells.Count
    If objRange.Cells(I).Range.Characters.Count > 2 Then
        flgEmpty = False
    End If
Next I

If flgEmpty = True Then
    Selection.Tables(1).Rows.Last.Delete
End If

' Cleanup

Set objCell = Nothing
Set objRange = Nothing
Application.ScreenUpdating = True

End Sub


Sub CellDelete()

Dim objCell As Cell
Dim objRange As Range

Dim lngCount As Long
Dim lngIndex As Long

Dim I As Integer
Dim flgEmpty As Boolean

Application.ScreenUpdating = False

' Determine the selected cell's index

Set objRange = Selection.Tables(1).Range
objRange.End = Selection.Cells(1).Range.End
lngIndex = objRange.Cells.Count

' Determine the original cell count

lngCount = Selection.Tables(1).Range.Cells.Count

' Delete the selected cell

Selection.Cells(1).Range.Delete

' Move downstream cells to the left

For I = lngIndex + 1 To lngCount
    Selection.Tables(1).Range.Cells(I).Range.Cut
    Selection.Tables(1).Range.Cells(I - 1).Range.Paste
Next I

' Delete the last row if empty

flgEmpty = True
Set objRange = Selection.Tables(1).Rows.Last.Range
For I = 1 To objRange.Cells.Count
    If objRange.Cells(I).Range.Characters.Count > 2 Then
        flgEmpty = False
    End If
Next I

If flgEmpty = True Then
    Selection.Tables(1).Rows.Last.Delete
End If

' Cleanup
Set objCell = Nothing
Set objRange = Nothing
Application.ScreenUpdating = True

End Sub
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Create HTML or Microsoft Word content and convert to Help file formats or 
printed documentation. Features include support for Windows Vista & 2007 
Microsoft Office, team authoring, plus more.
http://www.DocToHelp.com/TechwrlList

True single source, conditional content, PDF export, modular help.
Help & Manual is the most powerful authoring tool for technical
documentation. Boost your productivity! http://www.helpandmanual.com

---
You are currently subscribed to TECHWR-L as archive -at- web -dot- techwr-l -dot- com -dot- 

To unsubscribe send a blank email to 
techwr-l-unsubscribe -at- lists -dot- techwr-l -dot- com
or visit http://lists.techwr-l.com/mailman/options/techwr-l/archive%40web.techwr-l.com


To subscribe, send a blank email to techwr-l-join -at- lists -dot- techwr-l -dot- com

Send administrative questions to admin -at- techwr-l -dot- com -dot-  Visit
http://www.techwr-l.com/ for more resources and info.