Здравствуйте! Есть пользовательская форма. В прикрепленном примере - Лист2. Нужно сделать так, чтобы в поле Ссылка нужно было вводить только ссылку, но в таблицу она добавлялась уже как гиперссылка с заданным именем. Например, если добавляем Клиента4 (TextBox2) и его ссылку www.example.com (TextBox3), в столбце Ссылка должна появиться гиперссылка с адресом www.example.com и именем "Клиент4 - рабочий сайт". Часть имени " - рабочий сайт" должна добавляться автоматически, она постоянная для всех клиентов. Я знаю, как это делать вручную в ячейках формулой ГИПЕРССЫЛКА или через ПКМ - "Ссылка". Но как сделать так, чтобы форма автоматически создавала такие гиперссылки?..
Пробовала добавить в код формы перед "End if" это - выбивает ошибку. [vba]
Код
With Worksheets .Hyperlinks.Add Anchor:=.Range("C:C"), _ Address:=TextBox3.Value, _ TextToDisplay:="TextBox2.Value - рабочий сайт" End With
[/vba]
Здравствуйте! Есть пользовательская форма. В прикрепленном примере - Лист2. Нужно сделать так, чтобы в поле Ссылка нужно было вводить только ссылку, но в таблицу она добавлялась уже как гиперссылка с заданным именем. Например, если добавляем Клиента4 (TextBox2) и его ссылку www.example.com (TextBox3), в столбце Ссылка должна появиться гиперссылка с адресом www.example.com и именем "Клиент4 - рабочий сайт". Часть имени " - рабочий сайт" должна добавляться автоматически, она постоянная для всех клиентов. Я знаю, как это делать вручную в ячейках формулой ГИПЕРССЫЛКА или через ПКМ - "Ссылка". Но как сделать так, чтобы форма автоматически создавала такие гиперссылки?..
Пробовала добавить в код формы перед "End if" это - выбивает ошибку. [vba]
Код
With Worksheets .Hyperlinks.Add Anchor:=.Range("C:C"), _ Address:=TextBox3.Value, _ TextToDisplay:="TextBox2.Value - рабочий сайт" End With
Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range, rB As Range, rF As Range Application.ScreenUpdating = False Set rB = Intersect(Лист2.Range("B:B"), Target) Set rF = Intersect(Лист2.Range("F:F"), Target)
If Not rB Is Nothing Then Application.EnableEvents = False
For Each cell In rB.Cells
If Not IsEmpty(cell.Value) Then Sheets("Лист2").Hyperlinks.Add anchor:=cell.Offset(0, 4), Address:="http://" & cell.Offset(0, 1).Value, TextToDisplay:=cell.Offset(0, 0).Value End If
Next cell
Application.EnableEvents = True End If
If Not rF Is Nothing Then Application.EnableEvents = False
For Each cell In rF.Cells
If Not IsEmpty(cell.Value) Then Sheets("Лист2").Hyperlinks.Add anchor:=cell.Offset(0, 2), Address:="http://" & cell.Offset(0, -3).Value, TextToDisplay:=cell.Offset(0, 0).Value End If
Next cell
Application.EnableEvents = True End If
Application.ScreenUpdating = True End Sub
[/vba] Тот-же ответ что и на соседнем форуме.
marusa122, [vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range, rB As Range, rF As Range Application.ScreenUpdating = False Set rB = Intersect(Лист2.Range("B:B"), Target) Set rF = Intersect(Лист2.Range("F:F"), Target)
If Not rB Is Nothing Then Application.EnableEvents = False
For Each cell In rB.Cells
If Not IsEmpty(cell.Value) Then Sheets("Лист2").Hyperlinks.Add anchor:=cell.Offset(0, 4), Address:="http://" & cell.Offset(0, 1).Value, TextToDisplay:=cell.Offset(0, 0).Value End If
Next cell
Application.EnableEvents = True End If
If Not rF Is Nothing Then Application.EnableEvents = False
For Each cell In rF.Cells
If Not IsEmpty(cell.Value) Then Sheets("Лист2").Hyperlinks.Add anchor:=cell.Offset(0, 2), Address:="http://" & cell.Offset(0, -3).Value, TextToDisplay:=cell.Offset(0, 0).Value End If
Next cell
Application.EnableEvents = True End If
Application.ScreenUpdating = True End Sub
[/vba] Тот-же ответ что и на соседнем форуме.MikeVol