自动插入超链接怎么作啊？望高人指点

守柔

你不能只写问题啊！

你应该把你的想法和正确的结果告诉我啊，我只是按照你的附件要求作的，我已经给你最大的自由了，所有的书签和超级链自动加入了。

duke008

对不起，是我没说清楚。我也是刚接触vba，接触时间加起来也不超过48小时。没想到单元格中有一个段落和两个段落居然还会有如此差别。

要加超链接的那个单元格中，在完整的情况下，应该是有两个段落，一段中文，一段英文。

但是客户要求每天给他们传一次剪报，英文翻译在当天是来不及做完的，所以当天下午传给客户的是没有英文翻译的，即那个单元格中只有一个段落。

我刚才自己改了一下，先判断段落数是否大于1，如果大于1的话取第一段，否则取整个单元格。已经运行成功了。

再次感谢守柔老师。

gues1688

谢谢守柔老师，学习精彩代码，收获不小！

gues1688

to duke008,稍改一下cellRange就可以了:

Set myCol = myTable.Columns(5) '定义一个列对象
For Each oCell In myCol.Cells
RowId = oCell.RowIndex '取得行号
If RowId > 1 Then '不为首行
Set cellRange = oCell.Range.Paragraphs(1).Range '定义一个RANGE对象为该单元格的第一个段落
Set cellRange = .Range(cellRange.Start, cellRange.End - 1) '不包含段落标记的范围
HyBkName = "B" & VBA.Format(RowId - 1, "000")
'添加一个超级链接
ActiveDocument.Hyperlinks.Add Anchor:=cellRange, Address:="", SubAddress:=HyBkName
End If
Next

gues1688

学习并仿制守柔老师的代码：

Sub InsertBookmarkHyperlinker()
'以下代码完成的功能是在表格将自动插入书签和将指定单元格
'链接到TOP文本所在位置,并将TOP所在位置链接到表格指定单元格
'起始位置
Dim myTable As Table, oCell As Cell
Dim cellRange As Range
Dim myRange As Range, TopCount As Integer, strFind As String
Dim TopRange As Range, BkName As String, HyBkName As String
Dim i As Integer
strFind = "SGM News Clipping from China Top^p" '定义一个查找的字符串,为精确起见,加上段落标记
With ActiveDocument
If .Tables.Count < 1 Then Exit Sub '如果没有表格(目录),则退出运行
.Fields.Unlink '去除超链接,这是为确保查找的准确性
Set myTable = .Tables(1) '定义一个表格对象
For i = 2 To myTable.Rows.Count
Set cellRange = myTable.Cell(i, 1).Range
BkName = VBA.Format(i - 1, "000")
.Bookmarks.Add Name:="A" & BkName, Range:=cellRange
Set cellRange = myTable.Cell(i, 5).Range.Paragraphs(1).Range
Set cellRange = .Range(cellRange.Start, cellRange.End - 1)
.Hyperlinks.Add Anchor:=cellRange, SubAddress:="B" & BkName, ScreenTip:="转到详细内容"
Next

Set myRange = .Content '定义一个RANGE对象,为主文档文字部分
With myRange.Find '查找
.ClearFormatting '清除格式
.Text = strFind
Do While .Execute And myRange.Hyperlinks.Count = 0 '如果找到没有超级链接的这个段落文本
TopCount = TopCount + 1 '计数
Set TopRange = myRange.Words(6) 'TOP词组所在的RANGE位置
BkName = "B" & VBA.Format(TopCount, "000") '定义一个书签名
HyBkName = "A" & VBA.Format(TopCount, "000") '定义一个超级链接的名称(位置)
'添加一个书签
ActiveDocument.Bookmarks.Add Name:=BkName, Range:=TopRange
'添加一个超级链接
ActiveDocument.Hyperlinks.Add Anchor:=TopRange, Address:="", SubAddress:=HyBkName _
, ScreenTip:="返回目录"
Loop
End With
End With
End Sub

gues1688

呵呵，无意中发现VBA的帮助文件，这下学习方便多了，原先只能输入关键字后按F1查阅，颇有只见树木不见林的感觉：

C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\2052\VBUI6.CHM

haha123123

学习到不少，十分感谢！