求一句代码：表示word文档第1到第10行的区域

weiyingde

求一句代码：用VBA代码表示word文档第1到第10行的区域

duquancai

给定义了一个对象数组arr

Sub shishi()
    Dim p As Range, doc As Document, arr()
    Set doc = ActiveDocument
    doc.Bookmarks("\StartOfDoc").Select
    Do
        n = n + 1: ReDim Preserve arr(1 To n)
        If n = 1 Then
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            Set arr(1) = p
        Else
            p.Collapse 0: p.Select
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            Set arr(n) = p
        End If
    Loop Until p.End = doc.Content.End
End Sub

weiyingde

duquancai 发表于 2017-4-25 18:53
给定义了一个对象数组arr

Sub shishi()

很好，确实达到了目的。只是，以我目前的水平，还不能理解和消化，恐怕一时还不能进行变通使用，进行不了下一步的操作。

weiyingde

duquancai 发表于 2017-4-25 18:53
给定义了一个对象数组arr

Sub shishi()

我用两种循环读取arr元素时，发现第二种不行：
Sub shishi()
    Dim p As Range, doc As Document, arr()
    Set doc = ActiveDocument
    doc.Bookmarks("\StartOfDoc").Select
    Do
        n = n + 1: ReDim Preserve arr(1 To n)
        If n = 1 Then
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            Set arr(1) = p
        Else
            p.Collapse 0: p.Select
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            Set arr(n) = p
        End If
      msgbox arr(n)  ‘这个是正确。
    Loop Until p.End = doc.Content.End
   for  i = lbound(arr) to Ubound(arr)
     msgbox arr(i) '这个不行。
  next
End Sub
红色的代码显示的结果是：循环了N次，但只有最后一个数组元素显示有文本，其他N-1项显示的是空文本。
这说明：arr在上面的循环中，并没有将前边的元素保存下来，只保存最后一个。没有达到我的目的。
怎样才能确保arr能无一遗漏地将所有文本以10行的方式全部录入数组之中，便于在这个循环过程之外，方便调用。
烦请杜老师帮我再看看。

jiminyanyan

weiyingde 发表于 2017-4-25 20:27
我用两种循环读取arr元素时，发现第二种不行：
Sub shishi()
    Dim p As Range, doc As Document,  ...

Sub shishi()
    Dim p As Range, doc As Document, arr()
    Set doc = ActiveDocument
    doc.Bookmarks("\StartOfDoc").Select
    Do
        n = n + 1: ReDim Preserve arr(1 To n)
        If n = 1 Then
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            Set arr(1) = p.Duplicate
        Else
            p.Collapse 0: p.Select
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            Set arr(n) = p.Duplicate
        End If
      MsgBox arr(n)  '这个是正确。
    Loop Until p.End = doc.Content.End
   For i = LBound(arr) To UBound(arr)
     MsgBox arr(i) '这个不能不行。
  Next
End Sub

weiyingde

jiminyanyan 发表于 2017-4-25 20:58
Sub shishi()
    Dim p As Range, doc As Document, arr()
    Set doc = ActiveDocument

很好，非常感谢，这下，可以进行下面的任务了。

jiminyanyan

weiyingde 发表于 2017-4-25 20:27
我用两种循环读取arr元素时，发现第二种不行：
Sub shishi()
    Dim p As Range, doc As Document,  ...

Set arr(1) = p
这个p后来改变了,arr(1) 就没值了,
Set arr(1) = p.Duplicate
这样p改变了,不影响arr(1) 的值......

weiyingde

jiminyanyan 发表于 2017-4-25 21:03
Set arr(1) = p
这个p后来改变了,arr(1) 就没值了,
Set arr(1) = p.Duplicate

我对word VBA一点也不熟，只能在循环之外调用这个数组。
能否用其他的方式录入呢？这个循环过程中的.moveend和.collapse，太难理解，恐一时还难以对上面的代码进行变通和借用。

duquancai

weiyingde 发表于 2017-4-25 20:27
我用两种循环读取arr元素时，发现第二种不行：
Sub shishi()
    Dim p As Range, doc As Document,  ...

之前我说了是对象数组，如果需要值，那就这样啊！！！！》》》》》

Sub shishi()
    Dim p As Range, doc As Document, arr()
    Set doc = ActiveDocument
    doc.Bookmarks("\StartOfDoc").Select
    Do
        n = n + 1: ReDim Preserve arr(1 To n)
        If n = 1 Then
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            arr(1) = p.Text
        Else
            p.Collapse 0: p.Select
            Selection.MoveEnd 5, 10
            Set p = Selection.Range
            arr(n) = p.Text
        End If
    Loop Until p.End = doc.Content.End
End Sub

weiyingde

duquancai 发表于 2017-4-25 21:19
之前我说了是对象数组，如果需要值，那就这样啊！！！！》》》》》

Sub shishi()

也很好，谢谢了。
问一个过分的问题：还有简单一点的代码吗？
没有就算了。