В Excel создайте гиперссылку с символом «папка» в Юникоде, используя VBA. - PullRequest
Новая
       110

В Excel создайте гиперссылку с символом «папка» в Юникоде, используя VBA.

1 голос
/ 04 августа 2020

В Excel я пытаюсь создать гиперссылки, которые отображают значок папки Unicode (а также различные другие значки). Я могу сделать это вручную, щелкнув правой кнопкой мыши -> Гиперссылка ->, а затем «вырезать и вставить» символ из веб-браузера. Моя проблема в том, что я пытаюсь добавить гиперссылки с помощью VBA, но не знаю, как это сделать. Вот код, который я пытаюсь, но получаю сообщение об ошибке. Вы можете видеть, что в моем коде для создания гиперссылки я использую функцию ChrW с TextToDisplay: = ChrW (& H1F4C1) . К сожалению, Excel выдает ошибку при переходе к этой строке. 

'Purchase Orders Folder
    ActiveSheet.Range("ProjectTable[POs]").Cells(lastTblRowNum).Select                
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=poPath, TextToDisplay:=ChrW(&H1F4C1)

введите описание изображения здесь

1 Ответ

1 голос
/ 04 августа 2020

Существует верхний предел кода символа, принимаемого функцией ChrW (см. документацию MSDN ).

Нормальный диапазон для charcode - 0–255. Однако в системах DBCS фактический диапазон для кодировки составляет -32768–65535.

В вашем случае код символа для символа папки - 128193, поэтому он выходит за рамки этой функции.

Взяв один из предложенных ответов на этот вопрос (от Марка Толонена), ваш код может быть следующим (если вы используете Excel 2013 или выше): 

'Purchase Orders Folder
    ActiveSheet.Range("ProjectTable[POs]").Cells(lastTblRowNum).Select                
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=poPath, TextToDisplay:=WorksheetFunction.Unichar(&H1F4C1)

Если вы используете Excel 2010 или более раннюю версию, вам придется использовать один из других ответов, приведенных в упомянутом выше вопросе. Если вы выберете ответ milevyo, который использует обходной путь html, вам нужно будет добавить следующее: 

Function GetUnicode(CharCodeString As String) As String
    Dim Doc As New HTMLDocument
    Doc.Body.innerHTML = "&#x" & CharCodeString & ";"
    GetUnicode = Doc.Body.innerText
End Function

, и тогда ваш код будет: 

'Purchase Orders Folder
    ActiveSheet.Range("ProjectTable[POs]").Cells(lastTblRowNum).Select                
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=poPath, TextToDisplay:=GetUnicode("1F4C1")

Кроме того, убедитесь, что вы добавляете ссылку в библиотеку объектов Microsoft HTML.

...