Question

我已经为公司创建了一个用户表单来输入首选产品，其中包括产品的网站。目前，当用户点击提交时，所有信息都输入正确，但包含该网站的单元格不是该网站的超链接。如果我双击单元格（就像添加文本一样）然后退出单元格，它会将链接转换为超链接。

我需要使用什么VBA代码才能将在文本框中输入的数据转换为通过用户表单提交到工作表单元格中的超链接？

这是我所拥有的代码的基本版本（删除了其他部分）;

Private Sub ComboBoxDivision_Change()

Me.ComboBoxSpecsNumber = ""
Me.ComboBoxSpecsName = ""
Select Case Me.ComboBoxDivision
    Case "DIVISION 02 - EXISTING CONDITIONS"
    Me.ComboBoxSpecsNumber.RowSource = "D02_Number"
    Me.ComboBoxSpecsName.RowSource = "D02_Name"

    Case "DIVISION 03 - CONCRETE"
    Me.ComboBoxSpecsNumber.RowSource = "D03_Number"
    Me.ComboBoxSpecsName.RowSource = "D03_Name"

    Case "DIVISION 04 - MASONRY"
    Me.ComboBoxSpecsNumber.RowSource = "D04_Number"
    Me.ComboBoxSpecsName.RowSource = "D04_Name"    
End Select
End Sub

Private Sub ComboBoxSpecsNumber_Change()
Application.EnableEvents = False
  With ComboBoxSpecsNumber
    ComboBoxSpecsName.ListIndex = .ListIndex
  End With
  Application.EnableEvents = True
End Sub

Private Sub ComboBoxSpecsName_Change()
Application.EnableEvents = False
  With ComboBoxSpecsName
    ComboBoxSpecsNumber.ListIndex = .ListIndex
  End With
  Application.EnableEvents = True
End Sub

Private Sub SubmitButton_Click()
If Me.ComboBoxDivision.Value = "" Then
MsgBox "Please select a Division.", vbExclamation, "Product_Information_Form"
Me.ComboBoxDivision.SetFocus
Exit Sub
End If
If Me.ComboBoxSpecsNumber.Value = "" Then
MsgBox "Please select a Specs Number or Name.", vbExclamation, "Product_Information_Form"
Me.ComboBoxSpecsNumber.SetFocus
Exit Sub
End If
If Me.ComboBoxSpecsName.Value = "" Then
MsgBox "Please select a Specs Name or Name.", vbExclamation, "Product_Information_Form"
Me.ComboBoxSpecsName.SetFocus
Exit Sub
End If

Dim RowCount As Long
RowCount = Worksheets("FormData").Range("A1").CurrentRegion.Rows.Count
With Worksheets("FormData").Range("A1")
.Offset(RowCount, 0).Value = Me.ComboBoxDivision.Value
.Offset(RowCount, 1).Value = Me.ComboBoxSpecsNumber.Value
.Offset(RowCount, 2).Value = Me.ComboBoxSpecsName.Value
.Offset(RowCount, 3).Value = Me.TextBox_Website_Link.Value
.Offset(RowCount, 4).Value = Format(Now, "yyyy.mm.dd hh:mm:ss")
End With

Select Case Me.ComboBoxDivision
Case "DIVISION 02 - EXISTING CONDITIONS"
Dim LastRow As Long, ws As Worksheet
Set ws = Sheets("Div-02")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("a" & LastRow).Value = Me.ComboBoxSpecsNumber.Value
ws.Range("b" & LastRow).Value = Me.ComboBoxSpecsName.Value
ws.Range("c" & LastRow).Value = Me.TextBox_Website_Link.Value

Case "DIVISION 03 - CONCRETE"
Set ws = Sheets("Div-03")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("a" & LastRow).Value = Me.ComboBoxSpecsNumber.Value
ws.Range("b" & LastRow).Value = Me.ComboBoxSpecsName.Value
ws.Range("c" & LastRow).Value = Me.TextBox_Website_Link.Value

Case "DIVISION 04 - MASONRY"
Set ws = Sheets("Div-04")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("a" & LastRow).Value = Me.ComboBoxSpecsNumber.Value
ws.Range("b" & LastRow).Value = Me.ComboBoxSpecsName.Value
ws.Range("c" & LastRow).Value = Me.TextBox_Website_Link.Value


End Select

Unload Product_Information_Form
Start_Form.Show

End Sub

P.S。我曾尝试多次搜索解决方案，但总是获取有关如何向用户表单添加超链接的信息，这不是我需要的。

Answer 1

编辑：更新我的答案，因为我发现你有多个地方可能会写出一个链接......

首先添加此实用程序Sub：

Sub AddLink(c As Range, txt As String)
    If Len(txt) > 0 Then
        c.Formula = "=HYPERLINK(""" & txt & """)"
    Else
        c.Value = ""
    End If
End Sub

然后，无论你在哪里写一个链接，都可以使用那个子：

e.g。换行：

.Offset(RowCount, 3).Value = Me.TextBox_Website_Link.Value

ws.Range("c" & LastRow).Value = Me.TextBox_Website_Link.Value

到

AddLink .Offset(RowCount, 3), Me.TextBox_Website_Link.Value 

AddLink ws.Range("c" & LastRow), Me.TextBox_Website_Link.Value

分别

通过Userform提交的数据不会变为活动超链接

1 个答案: