使用VBA - Excel将超链接添加到表中的单元格

时间:2017-12-14 23:38:19

标签: excel vba excel-vba hyperlink

我的Excel有两张名为“投诉”和“添加行”的图纸。

我正在使用“添加行”表将一行(在带有值的最后一行之后)添加到“投诉”表中名为ComplaintsTable的表中,并且我正在使用与命令按钮配对的宏来执行此操作。 / p>

我的代码如下所示:

Private Sub CommandButton1_Click()
Dim LastRow As Long, ws As Worksheet, ws1 As Worksheet, newRow As ListRow

Set ws = Sheets("Complaints")
Set ws1 = Sheets("Add Row")
Set tbl = ws.ListObjects("ComplaintsTable")
Set newRow = tbl.ListRows.Add

With newRow
    .Range(2) = ws1.Range("C1").Value 'Complaint Yes/No
    .Range(12) = ws1.Range("C6").Value 'PCE Yes/No
End With

newRow.Range(4) = ws1.Range("C4").Value 'Subject
newRow.Range(21) = ws1.Range("C5").Value 'Entered Date

'To add Hyperlink
If (ws1.Range("C1").Value = "Yes") Then
    ws.Hyperlinks.Add Anchor:=tbl.newRow.Range(3), _
    Address:=ws1.Range("F3").Value, _
    ScreenTip:="Open Complaint in EtQ", _
    TextToDisplay:=Worksheets("Add Row").Range("F2").Value
End If

If (ws1.Range("C6").Value = "Yes") Then
    'To add hyperlink and PCE Number
    ws.Hyperlinks.Add Anchor:=tbl.newRow.Range(13), _
    Address:=ws1.Range("F8").Value, _
    ScreenTip:="Open PCE in EtQ", _
    TextToDisplay:=ws1.Range("F7").Value
End If
End Sub

不知何故,当我点击命令按钮添加值时,它不会添加任何内容!我哪里错了?

4 个答案:

答案 0 :(得分:1)

以下是带有屏幕截图的重构清理代码。正如@Ibo和我自己所提到的,问题很可能在于你已宣布并将newRow设置为范围,但后来将其用作表格的属性是不可能的。

Option Explicit

Private Sub CommandButton1_Click()
    Dim wsComplaints As Worksheet, wsAddRow As Worksheet
    Dim tblComplaints As ListObject
    Dim lngRows As Long

    With ThisWorkbook
        Set wsComplaints = .Worksheets("Complaints")
        Set wsAddRow = .Worksheets("Add Row")
    End With

    Set tblComplaints = wsComplaints.ListObjects("ComplaintsTable")

    tblComplaints.ListRows.Add

    lngRows = tblComplaints.ListRows.Count

    With tblComplaints
        .DataBodyRange(lngRows, 2) = wsAddRow.Cells(1, 3)
        .DataBodyRange(lngRows, 4) = wsAddRow.Cells(4, 3)
        .DataBodyRange(lngRows, 12) = wsAddRow.Cells(6, 3)
        .DataBodyRange(lngRows, 21) = wsAddRow.Cells(5, 3)
    End With

    If wsAddRow.Cells(1, 3) = "Yes" Then
        tblComplaints.DataBodyRange(lngRows, 3).Hyperlinks.Add _
        Anchor:=tblComplaints.DataBodyRange(lngRows, 3), _
        Address:=CStr(wsAddRow.Cells(3, 6)), _
        ScreenTip:="Open complaint in EtQ", _
        TextToDisplay:=CStr(wsAddRow.Cells(2, 6))
    End If

    If wsAddRow.Cells(6, 3) = "Yes" Then
        tblComplaints.DataBodyRange.Hyperlinks.Add _
        Anchor:=tblComplaints.DataBodyRange(lngRows, 13), _
        Address:=CStr(wsAddRow.Cells(8, 6)), _
        ScreenTip:="Open PCE in EtQ", _
        TextToDisplay:=CStr(wsAddRow.Cells(7, 6))
    End If
End Sub

解决方案的屏幕截图。

Sheet Add Row Sheet Complaints

答案 1 :(得分:0)

如果您点击按钮并且没有,甚至没有任何类型的错误,则可能会出现多个问题。

首先,如@Carol所述,newRow不应由tbl限定,因为newRow不是tbl的属性或方法

可能性1:
您已经在工作表中添加了一个表单控件按钮,您无法指定Private Sub CommandButton1_Click(),因为它是私有的,只能在它所放置的代码模块中使用,它不能被引用在它之外。

可能性2:
您已添加了ActiveX CommandButton,编写了Private Sub CommandButton1_Click()但随后更改了按钮的名称。在这种情况下,请将CommandButton1更改为您已命名为按钮的任何内容。

可能性3:
您遇到错误,点击调试并暂停代码。只要代码暂停,就不会触发新事件,因此您的按钮似乎什么都不做。这可以通过以黄色突出显示的代码行识别。您需要修复导致错误的行并通过点击F5或点击通常位于VBA窗口顶部附近的停止图标来恢复代码。

答案 2 :(得分:0)

您要显示的文本必须是零长度字符串,即无法创建超链接。

定义要在此之前显示的文本,以确保此行是问题:

myStr=Worksheets("Add Row").Range("F2").Value

尝试在添加超链接之前定义变量和范围对象,而不是使用.value等将它们放在字符串变量中,并确保它们都具有有效值。如果你试试这个,它应该可以工作,否则按照上面的说明,你会发现问题所在:

替换此块,如果有效,请以相同方式更改另一个块:

If (ws1.Range("C1").Value = "Yes") Then
    ws.Hyperlinks.Add Anchor:=tbl.newRow.Range(3), _
    Address:=ws1.Range("F3").Value, _
    ScreenTip:="Open Complaint in EtQ", _
    TextToDisplay:=IIf(mystr <> "", mystr, "Click Here")
End If

答案 3 :(得分:0)

我已经按如下方式更改了代码,它运行正常,没有任何错误。

Private Sub AddRow_Click()
Dim LastRow As Long, ws As Worksheet, ws1 As Worksheet
Dim newRow As ListRow ', tbl As ListObjects
Dim cmpNo As String, pceNo As String

Set ws = Sheets("Complaints")
Set ws1 = Sheets("AddRow")
Set tbl = ws.ListObjects("ComplaintsTable")
Set newRow = tbl.ListRows.Add

With newRow
    .Range(1) = ws1.Range("C1").Value 'Complaint Yes/No
    .Range(11) = ws1.Range("C6").Value 'PCE Yes/No
    .Range(3) = ws1.Range("C4").Value 'Subject
    .Range(20) = ws1.Range("C5").Value 'Entered Date
End With

'To add Hyperlink
If (ws1.Range("C1").Value = "Yes") Then
    Call ActiveSheet.Hyperlinks.Add(newRow.Range(2), ws1.Range("F3").Value, "", "Open in EtQ", ws1.Range("F2").Value)
End If

If (ws1.Range("C6").Value = "Yes") Then
    Call ActiveSheet.Hyperlinks.Add(newRow.Range(12), ws1.Range("F8").Value, "", "Open in EtQ", ws1.Range("F7").Value)
    'To add hyperlink and PCE Number
End If
End Sub

代码的问题是“newRow.Range”不能与“hyperlinks.add”一起使用。我几天前就把它搞砸了,但我没有机会发布这个。

感谢您的帮助!