Hi all,
I’ve been working on this macro for days and I’m hoping someone can help me. I’m using Excel 2007.
I have an existing workbook — let’s call it «WB1». WB1 has hyperlinks in column «C» that have the «Text to Display» shown in the cell with the actual URL not shown. So «C» would be something like «Click this link» and when they click it
it would go to the URL specified when the hyperlink was created. Note that column C on WB1 has been merged with other columns.
The workbook I’m creating is «WB2». If I do a copy/paste in my macro from cell C in WB1 to WB2 the result is also a merged cell on WB2. This would be OK, except that I then want to do some formatting, which can’t be done on merged cells.
So — what I want to do is use «hyperlinks.add» using the Anchor, Address, etc to get the hyperlink (including «text to display») from WB1 to WB2. This will allow me to get the cell from WB1 to WB2 without ending up with a merged cell in WB2.
I could easily do this if I wanted to copy a URL from one workbook to another, but in this instance I want the URL and the Text to Display on WB2.
The problem I’m having is I don’t know how to get the values for «text to display» and the «actual URL» out of the cell in WB1.
Can anyone shed some light on this. I’d really appreciate it.
BTW — I don’t have any control over WB1 — it comes to me that way.
KW
-
Edited by
Friday, January 27, 2012 2:15 AM
|
Всем доброго здоровья! Планета Excel Перенести гиперссылку довольно легко обычным Copy, но тогда я не смогу работать массивом; придется все делать на листе — а это очень долго. |
|
|
Sanja Пользователь Сообщений: 14838 |
#2 01.07.2017 12:29:48
Ну для одной ячейки можно так
А вот как получить это в массив без перебора ячеек — вопрос.. Согласие есть продукт при полном непротивлении сторон. |
||||
|
Sanja, спасибо, подумаю над этим вариантом. |
|
|
Sanja Пользователь Сообщений: 14838 |
#4 01.07.2017 12:36:57 Почитал тут справку. И т.к. HyperLinks это КОЛЛЕКЦИЯ, то с ней можно работать отдельно от ячеек. Например так
Изменено: Sanja — 01.07.2017 12:42:45 Согласие есть продукт при полном непротивлении сторон. |
||
|
Sanja Пользователь Сообщений: 14838 |
#5 01.07.2017 13:59:59 Михаил, как-то так получилось. Не знаю, насколько быстро будет на больших объёмах
Прикрепленные файлы
Согласие есть продукт при полном непротивлении сторон. |
||
|
Sanja, Ок, спасибо, попробую. |
|
|
RAN  Пользователь Сообщений: 7091 |
#7 01.07.2017 20:48:43 Немного поигрался. Количество гиперсылок — max возможное (65530 шт).
отрабатывает 40-50сек
1,5 минуты читает, 1,5 минуты пишет Изменено: RAN — 01.07.2017 20:49:12 |
||||
Предположим, у меня есть список значений в столбце A, и каждая ячейка содержит другую гиперссылку, теперь я хочу скопировать только гиперссылки без текста в другой столбец E, как показано на следующем снимке экрана. Возможно, нет прямого способа решить эту задачу в Excel, но здесь я могу ввести код VBA для решения этой проблемы.
Скопируйте гиперссылку из одной ячейки в другую с кодом VBA
Скопируйте гиперссылку из одной ячейки в другую с кодом VBA
Скопируйте гиперссылку из одной ячейки в другую с кодом VBAЧтобы скопировать только адреса гиперссылок без текста в другие ячейки, следующий код может оказать вам услугу, например:
1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.
2. Нажмите Вставить > Модулии вставьте следующий код в Модули Окно.
Код VBA: копировать гиперссылку только из одной ячейки в другую:
Sub CopyHyperlinks()
'Uodateby Extendoffice
Dim xSRg As Range
Dim xDRg As Range
Dim I As Integer
Dim xAddress As String
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xSRg = Application.InputBox("Please select the original range you want to copy hyperlinks:", "KuTools For Excel", xAddress, , , , , 8)
If xSRg Is Nothing Then Exit Sub
Set xDRg = Application.InputBox("Please select the new range you want to paste the hyperlinks only", "KuTools For Excel", , , , , , 8)
If xDRg Is Nothing Then Exit Sub
Set xDRg = xDRg(1)
For I = 1 To xSRg.Count
If xSRg(I) <> "" And xDRg.Offset(I - 1) <> "" Then
If xSRg(I).Hyperlinks.Count = 1 Then
xDRg(I).Hyperlinks.Add xDRg(I), xSRg(I).Hyperlinks(1).Address
End If
End If
Next
End Sub
3, Затем нажмите F5 нажмите клавишу для запуска этого кода, появится диалоговое окно, напоминающее вам о выборе ячеек, в которые вы хотите скопировать только гиперссылки, см. снимок экрана:
4, Затем нажмите OK, затем выберите ячейки, в которые вы хотите вставить гиперссылки, только в другое диалоговое окно, см. снимок экрана:
5. И адреса гиперссылок были скопированы из исходных ячеек в указанные ячейки по мере необходимости, см. Снимок экрана:
Внимание: Этот код также может помочь вам скопировать гиперссылки с одного листа на другой по вашему желанию.
Лучшие инструменты для работы в офисе
Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%
- Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
- Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон…
- Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны…
- Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
- Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
- Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии…
- Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
- Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF…
- Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
Вкладка Office: интерфейс с вкладками в Office и упрощение работы
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
- Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
- Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
Комментарии (13)
Оценок пока нет. Оцените первым!
|
|
Re: EXCEL VBA: How To: Copy Hyperlink while Preserving Target Format [RESOLVED]
Re: EXCEL VBA: How To: Copy Hyperlink while Preserving Target Format [RESOLVED]
RoryA
MrExcel MVP, Moderator
-
#2
That code doesn’t actually do anything. Can you post the code that actually transfers the cells?
-
#3
That code doesn’t actually do anything. Can you post the code that actually transfers the cells?
Apologies, here’ the full code:
Code:
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets("Orders")
Newsh.Rows("5:" & Newsh.Rows.Count).Clear
'The links to the first sheet will start in row 2
RwNum = 3
For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 1
RwNum = RwNum + 1
'Create a link to the sheet in the A column
Newsh.Hyperlinks.Add Anchor:=Newsh.Cells(RwNum, 1), Address:="", _
SubAddress:="'" & Sh.Name & "'!A1", TextToDisplay:=Sh.Name
For Each myCell In Sh.Range("J9,D9,D13,O66,D8,A1")
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
End If
Next ShWhat basically happens, as you can probably tell from the code, a sheet called Orders is created and pulls info from the cells («J9,D9,D13,O66,D8,A1») from all other sheets created.
Last edited by a moderator: Dec 19, 2016
RoryA
MrExcel MVP, Moderator
-
#4
You can’t return a hyperlink like that. Would it be OK to simply copy that cell across directly, or do you actually need the two cells linked?
-
#5
You can’t return a hyperlink like that. Would it be OK to simply copy that cell across directly, or do you actually need the two cells linked?
Ideally they need to be linked… the Orders sheet links to the cells J9,D9,D13,O66,D8,A1 from all other created sheets automatically. Users can access the link from the other sheets, the Orders sheet just collates certain cells creating a list with the most important data and cell A1 is a hyperlink to a PDF attachment.
If it can’t be done, I’ll just have to re think the hyperlink scenario.
Thanks for your time…
Steven.
RoryA
MrExcel MVP, Moderator
-
#6
What exactly is in A1 on the source sheet? If it’s the path to the file, you could use a HYPERLINK formula to create the link in the new sheet.
-
#7
What exactly is in A1 on the source sheet? If it’s the path to the file, you could use a HYPERLINK formula to create the link in the new sheet.
Yes, that’s exactly what A1 is, it’s a user created Hyperlink to a PDF file on the Server. The current code just doesn’t copy the Hyperlink across.
RoryA
MrExcel MVP, Moderator
-
#8
Does the displayed text include the file path, or just the file name?
-
#9
Does the displayed text include the file path, or just the file name?
Just the file name…
RoryA
MrExcel MVP, Moderator
-
#10
Then you’ll need a UDF in the file to extract the actual path of the hyperlink. So you could add this:
Code:
Function HLinkPath(Cell As Range) As String
On Error Resume Next
HLinkPath = Cell(1).Hyperlinks(1).Address
End Functionto your module. Then alter your current code to this:
Code:
For Each myCell In Sh.Range("J9,D9,D13,O66,D8,A1")
ColNum = ColNum + 1
if mycell.address(0,0) = "A1" then
Newsh.Cells(RwNum, ColNum).Formula = _
"=HYPERLINK(HLinkPath('" & Sh.Name & "'!" & myCell.Address(False, False) & "))
else
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
end if
Next myCell