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

Question

我有一个Excel，有两张名为“Complaints”和“Add Row”的表格。

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

我的代码看起来像这样：

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

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

Answer 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

解决方案的屏幕截图。

Answer 2

如果你点击按钮什么都没有，甚至没有任何类型的错误，可能会有几个问题。

首先，如@Carol所述，newRow不应该被tbl限定，因为newRow不是tbl的财产或方法

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

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

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

Answer 3

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

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

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

Answer 4

我已经更改了代码如下，它运行良好，没有任何错误。

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”一起使用。几天前我把它搞砸了，但我没有机会发布这个。

我感谢你的帮助！