2016-12-02 67 views
0

我有一個Word文檔,其中包含隱藏文本標記的部分<答案> ...有些表​​格... </Answers>。 Word宏可以返回這些標籤之間的文本範圍(以前是書籤,但他們必須去)。從Word表中檢索信息

我想從Excel做的事情是打開Word文檔,獲取標籤之間的範圍,迭代該塊中的表格並從每一行中檢索一些單元格。然後,這些單元格數據被寫入一個新的Excel工作表的某些行中。

我看到很多Word/Excel自動化,但沒有一個啓發我在兩段文本之間檢索範圍。最好的辦法是能夠在Word中運行Word宏RetrieveRange(strTagName,rngTextBlock)以返回rngTextBlock中的「Answers」範圍,但這似乎不可能。

作爲背景:.docm文件是一份包含答案和最大分數的試卷,我想將其轉移到Excel中以包含每個學生的評分。

回答

0

雖然瀏覽了一些更多的網站,但我遇到了一個C#示例,它部分地做了我所需要的:而不是使用Word的SELECTION來找到範圍。我現在可以找到兩個標籤之間的文本塊,但仍然無法遍歷其表格和表格行。沒有編譯器錯誤(並在Word本身工作),但我必須缺少一個外部鏈接...

Function CreateSEWorksheet() As Boolean 
    ' Find <ANSWERS> in Word Document, and traverse all tables and write them as rows in worksheet 

    Dim wdrngStart As Word.Range 
    Dim wdrngEnd As Word.Range 
    Dim wdrngAnswers As Word.Range 
    Dim wdTable As Word.Table 
    Dim wdRow As Word.Row 
    Dim strStr As String 
    Dim bGoOn As Boolean 

' Following set elsewhere: 
' Set WDApp = GetObject(class:="Application.Word") 
' Set WDDoc = WDApp.Documents.Open(filename:="filespec", visible:=True) 

    Set wdrngStart = WDDoc.Range ' select entire document - will shrink later 
    Set wdrngEnd = WDDoc.Range 
    Set wdrngAnswers = WDDoc.Range 

    ' don't use Word SELECT/SELECTION but use ranges instead when finding tags. 
    If wdrngStart.Find.Execute(findText:="<ANSWERS>", MatchCase:=False) Then 
    ' found! 
    wdrngAnswers.Start = wdrngStart.End 
    If wdrngEnd.Find.Execute(findText:="</ANSWERS>", MatchCase:=False) Then 
     wdrngAnswers.End = wdrngEnd.Start 
     bGoOn = True 
    Else 
     ' no closing tag found 
     bGoOn = False 
    End If 
    Else 
    'no opening tag found 
    bGoOn = False 
    End If 

If bGoOn Then 
    For Each wdTable In wdrngAnswers.Tables 
     ' ** below doesn't work anymore: object doesn't support this method ** 
     For Each wdRow In wdTable 
     ' as example, take column 4 of each row 
     strStr = wdRow.Cells(4).Range.Text 
     strStr = Left(strStr, Len(strStr) - 2) ' remove end of cell markers 
     Debug.Print strStr 
     Next 
    Next 
    CreateSEWorksheet = True 
Else 
    CreateSEWorksheet = False 
End If 

End Function