[求助]word到excel,超链接怎样传过去

duke008

9KKRBnQE.rar (20.15 KB, 下载次数: 16)

2005-12-16 23:36 上传

点击文件名下载附件
[求助]word到excel,超链接怎样传过去

Sub list() Dim i As Integer, tc As Integer tc = ActiveDocument.Tables.Count Set mydoc = ActiveDocument Set xlobj = CreateObject("excel.application") xlobj.Visible = True Set xlwb = xlobj.workbooks.Add For i = 1 To tc xlwb.worksheets("sheet1").Cells(i, 4).Value = mydoc.Range(mydoc.Tables(i).Cell(2, 3).Range.Start, mydoc.Tables(i).Cell(2, 3).Range.End - 1) xlwb.worksheets("sheet1").Cells(i, 2).Value = mydoc.Range(mydoc.Tables(i).Cell(5, 3).Range.Start, mydoc.Tables(i).Cell(5, 3).Range.End - 1) 'word中的这个单元格内放的是超链接,用现在的方法只能传纯文本,链接就丢了,我怎样才能把超链接也传过去呢? xlwb.worksheets("sheet1").Cells(i, 3).Value = mydoc.Range(mydoc.Tables(i).Cell(3, 3).Range.Start, mydoc.Tables(i).Cell(3, 3).Range.End - 1) xlwb.worksheets("sheet1").Cells(i, 5).Value = mydoc.Tables(i).Range.Information(wdActiveEndPageNumber) Next i End Sub

[此贴子已经被作者于2005-12-16 23:46:11编辑过]

守柔

供参考：

Sub list()
Dim i As Integer, tc As Integer, mydoc As Document, myTable As Table
tc = ActiveDocument.Tables.Count
Set mydoc = ActiveDocument
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
Set xlwb = xlobj.workbooks.Add
With xlwb.worksheets("sheet1")
For i = 1 To tc
Set myTable = mydoc.Tables(i)
.Cells(i, 4).Value = mydoc.Range(myTable.Cell(2, 3).Range.Start, myTable.Cell(2, 3).Range.End - 1)
.Cells(i, 2).Value = mydoc.Range(myTable.Cell(5, 3).Range.Start, myTable.Cell(5, 3).Range.End - 1)
If myTable.Cell(5, 3).Range.Hyperlinks.Count = 1 Then .Hyperlinks.Add Anchor:=.Cells(i, 2), Address:=myTable.Cell(5, 3).Range.Hyperlinks(1).Name
.Cells(i, 3).Value = mydoc.Range(myTable.Cell(3, 3).Range.Start, myTable.Cell(3, 3).Range.End - 1)
.Cells(i, 5).Value = myTable.Range.Information(wdActiveEndPageNumber)
Next i
End With
End Sub

duke008

谢谢守柔老师,问题解决!