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 sufixAddress As String

    Set xCell = ActiveSheet.Range("F22")
    Set ws = ActiveSheet
    prefixAddress = "www."
    sufixAddress = ".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) = sufixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, Address:="", SubAddress:= _
                xCell & sufixAddress, TextToDisplay:=xCell & sufixAddress
            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 sufixAddress As String

    Set xCell = ActiveSheet.Range("F22")
    Set ws = ActiveSheet
    prefixAddress = "www."
    sufixAddress = ".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) = sufixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, address:="", SubAddress:= _
                xCell & sufixAddress, TextToDisplay:=xCell & sufixAddress
            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

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

1 个答案: