电话号码簿中间插入人员，如何在插入行往下顺移一行

菊石泽露

sylun兄，谢谢你了！

中间有一些不规范的合并单元格，运行后有些表格就乱了，而且没在光标出插入一空行！

剪切粘贴的办法可行，模拟手工作业，如果再辅以判断，更好些。比如最后表格有无空行，若无，再建一同样格式的空表格，如有，则把有数据的地方剪切到空行。

我的目的是学习vba，而不是完成这个工作。sylun兄，目前我还跟你不上，对一些对象属性方法还不知如何运用，你的回复是我最好的教材！如果整理的有最基本的应用实例，请给我个电子文档，ju_shi0347@163.com,谢谢你了！

sylun

我的学习资料均来自本论坛及word帮助文件。

继续练习处理表格。原代码确实存在问题，原来没注意这个，也没有用附件测试。以我目前的能力，最多只能将各表格按统一行数的方式顺移。以下程序稍长，而且还有些问题未能解决，手法也是初级的，运行效率无力考究，也不知能否在较大的文档中运行。希望能得到各位的指点。

Sub move_row()

'设定每个表格为不多于11行

    Dim i As Integer, n As Integer, k As Integer, c As Integer

    Dim myRange As Range, testlen As Long, m As Integer

   

    Application.ScreenUpdating = False

    With ThisDocument.Range

        If .Tables.Count > 1 Then

            For i = 1 To .Tables.Count - 1

                If .Tables(i).Rows.Count > 11 Then

                    '计算多出的行数

                    n = .Tables(i).Rows.Count - 11

                    '删除多出部分的空白行

                    k = 12

                    Do While k < 12 + n

                        k = k + 1

                        .Tables(i).Cell(k, 1).Select

                        Selection.MoveEnd unit:=wdRow

                        If Len(Selection.Range.Text) < 13 Then

                            Selection.MoveDown Count:=n - 1, Extend:=wdExtend

                            Selection.Cut

                            Exit Do

                        End If

                    Loop

                    '移动多余的行

                    If .Tables(i).Rows.Count > 11 Then

                        .Tables(i).Cell(12, 1).Select

                        With Selection

                            .MoveEnd unit:=wdRow

                            .MoveDown Count:=n - 1, Extend:=wdExtend

                            .Range.Cut

                        End With

                        .Tables(i + 1).Cell(2, 1).Select

                        Selection.MoveEnd unit:=wdRow

                        Selection.Paste

                    End If

                End If

            Next

[此贴子已经被作者于2007-3-25 16:56:14编辑过]

sylun

            '处理最后一个表格
         With .Tables(.Tables.Count)

                If .Rows.Count > 11 Then
                            testlen = Len(.Rows(12).Range.Text)

                    If testlen > 12 Then

                        .Range.Copy

                        .Range.Select

                        With Selection

                            .MoveDown Count:=2

                            For m = 1 To 5

                                .TypeParagraph

                            Next m

                            .Paste

                        End With

                        Set myRange = Selection.GoToPrevious(what:=wdGoToTable)

                        With myRange.Tables(1)

                            .Rows(2).Select

                            Selection.MoveDown Count:=9, Extend:=wdExtend

                            Selection.Cut

                            c = 11 - .Rows.Count

                            .Rows.Last.Select

                            Selection.InsertRowsBelow c

                            Exit Sub

                        End With

                    End If

                End If

            End With

        End If

    End With

    Application.ScreenUpdating = True

End Sub

[此贴子已经被作者于2007-3-25 17:24:04编辑过]

学习中提高

利用插入文本框方法可以解决号码编辑问题。

1.在文档中根据需要插入N个文本框;

2.将所有人员号码利用表格一次性编辑好后，复制到第一个文本框中,点击"文本框工具栏"中的"创建文本框链接",会将第一个文本框中显示不下的内容链接到第二个文本框,依此类推,直到排完所有内容.

菊石泽露

谢谢楼上提供的新方法，我试着做做看！