时间戳

首页 > 解决方案 > 使用单元格中的 URL 强制格式化

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

问题描述

我正在尝试在用户将 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

标签： excelvbahyperlink

解决方案

您可以尝试如下所示：

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

推荐阅读