EXCEL-VBA超链接转换查询

时间:2015-04-17 02:57:11

标签: excel vba excel-vba hyperlink

Dim RITMRow As Long
Dim ws1 As Worksheet
Dim RITMstorage As String
Dim LastRow As Long




Set ws1 = Sheets("Tracker")


LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row

For RITMRow = 2 To LastRow


RITMstorage = ws1.Range("A" & RITMRow).Value



ws1.Range("A" & RITMRow).Hyperlinks.Add Anchor:=ws1.Range("A" & RITMRow), _
    Address:="https://site.site.com/sc_req_item.do?sys_id=" & RITMstorage, _
    ScreenTip:="Request Number", _
    TextToDisplay:=RITMstorage


Next RITMRow


With ws1

.Cells.Font.Size = "8"
.Cells.RowHeight = 11.25
.Cells.Font.Name = "Calibri"
.Range("A1").EntireRow.RowHeight = 25

End With

嗨,我上面的代码可以将列转换为超链接。正如你所看到的那样,每次点击按钮都会产生相当低效的效果,它会返回并将所有内容再次转换为超链接,即使是那些已经超链接的超链接。请指出我正确的方向。我需要一种方法来检测已经有偏移量超过1的列,然后转换非超链接单元格。

提前感谢。

1 个答案:

答案 0 :(得分:0)

只是尝试从单元格中获取地址并检查是否收到错误:

Dim url As String
Dim isLink As Boolean
For RITMRow = 2 To LastRow

    On Error Resume Next
    url = ws1.Range("A" & RITMRow).Hyperlinks(1).SubAddress
    isLink = (Err.Number = 0)
    On Error GoTo 0

    If Not isLink Then
        RITMstorage = ws1.Range("A" & RITMRow).Value
        ws1.Range("A" & RITMRow).Hyperlinks.Add Anchor:=ws1.Range("A" & RITMRow), _
            Address:="https://site.site.com/sc_req_item.do?sys_id=" & RITMstorage, _
            ScreenTip:="Request Number", _
            TextToDisplay:=RITMstorage
    End If

Next RITMRow