使用单元格中的 URL 强制格式化

Question

我正在尝试在用户将 URL 输入合并单元格（“F22:I22”）的位置自动将其格式化为 URL/超链接。因此，如果有人输入google.com，它将使其成为https://www.google.com/ 并验证它。

我有。 （我几乎可以肯定这是错误的）

Sub formaturl () 
    if ishyperlink(value) then values (x,y) = format(value, "https:// .com")
End Sub 

我看过代码，您可以在其中使用下拉菜单将超链接添加到单元格。这不是我想要的，因为用户将添加他们的公司 URL。

编辑：这是我能够开始工作的最终代码。我还将“超链接”单元格样式修改为没有下划线的 Arial 16 号字体，以便于阅读。

Sub handlethingone(target As Range)

    Dim ws As Worksheet
    Dim xCell As Range
    Dim prefixAddress As String
    Dim suffixAddress As String

    Set xCell = ActiveSheet.Range("F22")
    Set ws = ActiveSheet
    prefixAddress = "www."
    suffixAddress = ".com"

    With ws
       If .Range("F22").Value <> vbNullString Then
            If Not Left(.Range("F22").Value, 4) = prefixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, Address:="", SubAddress:= _
                prefixAddress & xCell, TextToDisplay:=prefixAddress & xCell
            End If
            If Not Right(.Range("F22").Value, 4) = suffixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, Address:="", SubAddress:= _
                xCell & suffixAddress, TextToDisplay:=xCell & suffixAddress
            End If
        End If
    End With
  With xCell.Font
        .Name = ("Arial")
        .Size = 16
        .Color = RGB(0, 0, 0)
        .Underline = xlUnderlineStyleNone
    End With

    With xCell.Font
        .Name = ("Arial")
        .Size = 16
        .Color = RGB(0, 0, 0)
        .Underline = xlUnderlineStyleNone
    End With



End Sub

Answer 1

您可以尝试如下所示：

Option Explicit
Sub HyperlinkFormatter()

    Dim ws As Worksheet
    Dim xCell As Range
    Dim prefixAddress As String
    Dim suffixAddress As String
    
    Set xCell = ActiveSheet.Range("F22")
    Set ws = ActiveSheet
    prefixAddress = "www."
    suffixAddress = ".com"
    
    With ws
       If .Range("F22").value <> vbNullString Then
            If Not Left(.Range("F22").value, 4) = prefixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, address:="", SubAddress:= _
                prefixAddress & xCell, TextToDisplay:=prefixAddress & xCell
            End If
            If Not Right(.Range("F22").value, 4) = suffixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, address:="", SubAddress:= _
                xCell & suffixAddress, TextToDisplay:=xCell & suffixAddress
            End If
        End If
    End With
    
    With xCell.Font
        .ColorIndex = xlAutomatic
        .Underline = xlUnderlineStyleNone
    End With

    With xCell.Font
        .Underline = xlUnderlineStyleSingle
        .Color = -4155132
    End With

End Sub