Делаем слово жирным в текстовом поле

Question

Делаем слово жирным в текстовом поле

Новое в переполнении стека, я строю макрос в Excel с VBA. По сути, у меня есть файл с несколькими вкладками с информацией в таблицах, в этих таблицах есть текст, и некоторые слова из этого текста выделены жирным шрифтом и повторяются на каждой вкладке (скажем, владелец и процесс). Я отображаю эту информацию в текстовом поле, расположенном в форме в соответствии со строкой таблицы, которую они выбирают в списке, текст отображается правильно, но игнорирует форматирование текста (полужирный и курсив). Есть ли способ отобразить форматирование текста в текстовом поле, как в таблице?

Надеюсь, я достаточно ясно дал понять.

1

excel vba excel-vba textbox userform text-formatting

Источник

user9927328 12 июн '18 в 12:58

2 ответа

Другие вопросы по тегам excel vba excel-vba textbox userform text-formatting

user2474656 12 июн '18 в 13:10 2018-06-12 13:10 · Answer 1 · 2018-06-12 13:10

Типичный пример для Shape текстовое поле (не ActiveX):

Sub BoxMaker()
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 217.5, 51#, _
        482.25, 278.25).Select
    Selection.Name = "SPLASH"
    Selection.Characters.Text = "Please Wait for Macro"
    With Selection.Characters(Start:=1, Length:=21).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 36
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

    Selection.Characters(Start:=8, Length:=4).Font.Bold = True

    Selection.HorizontalAlignment = xlCenter
    Selection.VerticalAlignment = xlCenter
End Sub

Вы можете отформатировать текст в текстовом поле, похожем на текст в ячейке.

user6460297 12 июн '18 в 17:31 2018-06-12 17:31 · Answer 2 · 2018-06-12 17:31

Возможное решение в UserForm с использованием элемента управления Webbrowser

Из-за вашего комментария: "... на самом деле я использую MSForms.TextBox"

Возможным обходным решением будет создание простого HTML-файла с использованием тега b (например, blabla внутри обычного текста,выделенного жирным шрифтом...) для жирного текста и загрузка его в элемент управления Webbrowser (требуется ссылка на элементы управления Microsoft Internet), например, через WebBrowser1. Перейдите по ссылке ThisWorkbook.Path & "\topic.htm".

Поскольку HTML обычно использует кодировку utf-8, я демонстрирую подход с использованием системной функции. WideCharToMultiByte (Вызов API).

Пример вызова с использованием вспомогательных функций (вызовы API)

' declare and assign simple html string
  Dim htmlstring as String
  htmlstring = "<html><body><div>Normal text <b>bold text</b> further text</div></body></html>"
' write html file via helper procedure  
  writeUtf8 htmlstring, ThisWorkbook.Path & "\topic.htm"
' load html file into WebBrowswer control
  Me.WebBrowser1.Navigate ThisWorkbook.Path & "\topic.htm"

Вспомогательные процедуры

Я предлагаю написать отдельный модуль кода для этих вспомогательных функций:

Option Explicit  ' declaration head of separate code module

' Declare API Function
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" ( _
  ByVal CodePage As Long, _
  ByVal dwFlags As Long, _
  ByVal lpWideCharStr As Long, _
  ByVal cchWideChar As Long, _
  ByVal lpMultiByteStr As Long, _
  ByVal cbMultiByte As Long, _
  ByVal lpDefaultChar As Long, _
  ByVal lpUsedDefaultChar As Long) As Long


Public Sub writeUtf8(ByVal s As String, ByVal datei As String)
' Purpose: save HTML String in utf-8 mode 
' Note:    called by  writeUtf8 htmlstring, thisworkbook.path & "\topic.htm"
Dim file As Integer
Dim B() As Byte
  file = FreeFile
  Open datei For Binary Access Write Lock Read Write As #file
  getUtf8 s, B
  Put #file, , B
  Close #file
End Sub

Private Sub getUtf8(ByRef s As String, ByRef B() As Byte)
' Note: called by above helper function; uses API call (see declaration head)
Const CP_UTF8 As Long = 65001
Dim len_s As Long
Dim ptr_s As Long
Dim size As Long
  Erase B
  len_s = Len(s)
  If len_s = 0 Then _
    err.Raise 30030, , "Len(WideChars) = 0"
  ptr_s = StrPtr(s)
  size = WideCharToMultiByte(CP_UTF8, 0, ptr_s, len_s, 0, 0, 0, 0)
  If size = 0 Then _
    err.Raise 30030, , "WideCharToMultiByte() = 0"
  ReDim B(0 To size - 1)
  If WideCharToMultiByte(CP_UTF8, 0, ptr_s, len_s, VarPtr(B(0)), size, 0, 0) = 0 Then _
    err.Raise 30030, , "WideCharToMultiByte(" & Format$(size) & ") = 0"
End Sub