Question

我已经为公司创建了一个用户表单来输入首选产品，其中包括产品的网站。我设置了网站将作为普通文本输入的位置，但Excel中的自动功能在单元格包含网站时注册并未将文本转换为活动超链接。我能够从Tim Williams那里得到堆栈溢出的帮助来创建一个超链接，但是=超链接功能可以处理与{google.com不同的https://www.google.com，这可以通过更多代码来解决，但我更喜欢尽可能使用更少的代码。

如果我双击单元格（没有=超链接）就好像要添加文本然后退出单元格，它会将链接转换为超链接。

我需要使用什么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

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

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
AddLink .Offset(RowCount, 3), 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
AddLink ws.Range("c" & LastRow), 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
AddLink ws.Range("c" & LastRow), 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
AddLink ws.Range("c" & LastRow), Me.TextBox_Website_Link.Value


End Select

Unload Product_Information_Form
Start_Form.Show

End Sub

将带有网站文本的单元格更改为链接（不使用=超链接功能）

0 个答案: