|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
请楼主测试一下:
Option Explicit
Sub Example()
Dim myTable As Table, myBM As String, Columnid As Byte, aCell As Cell
Dim myRange As Range, Rowid As Integer, i As Integer, n As Integer
Dim startPost As Long, EndPost As Long
myBM = "myBookMark"
With ActiveDocument
Set myTable = .Tables(2) '定义一个表格对象为文档中的表格2
Set myRange = myTable.Cell(1, 1).Range '定义一个RANGE对象为表格2的第一个单元格
myRange.SetRange myRange.Start, myRange.End - 1 '重新定义RANGE对象(去除单元格结束标记)
.Bookmarks.Add Name:=myBM & "0", Range:=myRange '此RANGE对象添加一个书签(返回)
For Each aCell In myTable.Range.Cells '在该表格中循环
Rowid = aCell.RowIndex '取得行号
Columnid = aCell.ColumnIndex '取得列号
If Rowid > 2 Then '如果行号>2
If Columnid = 2 Then '如果在第2列(股票代码)
Set myRange = aCell.Range '定义一个RANGE对象
myRange.SetRange myRange.Start, myRange.End - 1 '去除段单元格结束标记
.Bookmarks.Add Name:=myBM & aCell.RowIndex - 2, Range:=myRange '添加书签
ElseIf Columnid = 7 Then '如果为第7列(报告摘要)
Set myRange = aCell.Range
myRange.SetRange myRange.Start, myRange.End - 1
.Bookmarks.Add Name:="摘要" & aCell.RowIndex - 2, Range:=myRange
End If
End If
Next
Set myRange = .Range(myTable.Range.End, myTable.Range.End)
myRange.InsertAfter "▲返回" '在该表格后面自动插入一个文字,并且为右对齐
myRange.ParagraphFormat.Alignment = wdAlignParagraphRight
.Hyperlinks.Add Anchor:=myRange, SubAddress:=myBM & "0" '添加一个超级链接,指向第一个单元格
Set myTable = .Tables(4) '定义一个表格对象,为活动文档的第四个表格
For Each aCell In myTable.Range.Cells '在单元格中循环
If VBA.InStr(aCell.Range.Text, "报告日期") > 0 Then '如果带有指定文本,注意此处标识不显著
Set myRange = aCell.Range
startPost = VBA.InStr(myRange.Text, "(") '以左右括号为标识
EndPost = VBA.InStr(myRange.Text, ")")
myRange.SetRange myRange.Start + startPost, myRange.Start + EndPost - 1
n = n + 1 '累加
.Hyperlinks.Add Anchor:=myRange, SubAddress:=myBM & n '增加超级链接
myRange.SetRange myRange.Paragraphs(1).Range.Start, myRange.Paragraphs(1).Range.Start
i = i + 1 '累加
.Bookmarks.Add Name:="股票" & i, Range:=myRange '添加书签
.Hyperlinks.Add Anchor:=.Bookmarks("摘要" & i).Range, SubAddress:="股票" & i '将摘要的超级链接指向此书签对象
ElseIf VBA.InStr(aCell.Range.Text, "返回") > 0 Then
Set myRange = aCell.Range
myRange.SetRange myRange.Start, myRange.End - 1
.Hyperlinks.Add Anchor:=myRange, SubAddress:=myBM & "0"
End If
Next
End With
End Sub
Sub DelAllBMHpyerlinks() '初始化,清除所有书签和断开所有超级链接
Dim oBM As Bookmark
With ActiveDocument
For Each oBM In .Bookmarks
oBM.Delete
Next
.Fields.Unlink
End With
End Sub
[此贴子已经被作者于2006-1-6 18:52:44编辑过] |
|