Принудительное форматирование с помощью URL в ячейке - PullRequest
0 голосов
/ 14 мая 2019

Я пытаюсь сделать так, чтобы пользователь вводил 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

1 Ответ

0 голосов
/ 14 мая 2019

Вы можете попробовать что-то вроде ниже.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...