Модераторы: mihanik
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> RichTextBox без richtx32.ocx, RichTextBox через API в окне макроса  
:(
    Опции темы
kuksha
Дата 22.7.2017, 20:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 144
Регистрация: 15.6.2011

Репутация: нет
Всего: нет



В связи с граблями при регистрации richtx32.ocx (для неспециалиста), есть потребность использовать RichTextBox в диалоговом окне макроса, работающего под MS Word БЕЗ использования richtx32.ocx
Насколько я понимаю, OCX - это прокладка между DLL и VBA. Вот и появилась мысль убрать этот самый OCX - нарисовать RichTextBox при помощи API и как-то с ним общаться... 
Общение через API с буфером обмена у меня получилось, а вот с RichTextBox пока никак...

Нужно создать элемент RichTextBox в диалоговом окне MS Word, 
вставить в созданный элемент текст - это вроде бы есть в примере ниже...
и получить текст обратно после изменения пользователем (закинуть в буфер обмена, чтобы сохранился RTF).

Приведу пример решения очень схожей задачи с какого-то французского форума, просто чтобы понятно было о каком уровне идёт речь. Французские комментарии перевёл я.
Указанный код создаёт RichTextBox и вытаскивает "голый текст" из RTF. Работает в MSAccess. 
Собственно, это часть решения, но сильно неполная... В MS Word сия функция не запускается хотя бы по причине отсутствия HwndAccessApp - я не работал с API и не знаю чем его заменить в MS Word. 

Кто умеет на таком уровне работать? 

Код

Option Explicit
 
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias _
                        "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String _
                        , ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long _
                        , ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long _
                        , ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long _
                        , lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const WC_RICHEDIT1 = "RichEdit"
Private Const WC_RICHEDIT2 = "RichEdit20A"
Private Const WS_CHILD = &H40000000
Private Const ES_MULTILINE = &H4&
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
 
Function RTFtoTEXT(pRTF As String) As String
Dim lLen As Long
Dim ltext As String
Dim lClass As String
Dim lHwnd As Long
On Error GoTo Gestion_Erreurs
' Загрузка библиотеки
' cf http://msdn2.microsoft.com/en-us/library/bb787873(VS.85).aspx
If LoadLibrary("Riched20.dll") > 32 Then
    lClass = WC_RICHEDIT2
ElseIf LoadLibrary("Riched32.dll") > 32 Then
    lClass = WC_RICHEDIT1
End If
' Создает окно с текстовым редактором
lHwnd = CreateWindowEx(0, lClass, vbNullString, _
                       WS_CHILD Or ES_MULTILINE, 0, 0, 0, 0, Application.HwndAccessApp, 0&, 0&, ByVal 0&)
' Внедряет текст в элементе управления
SendMessage lHwnd, WM_SETTEXT, Len(pRTF), ByVal pRTF
' Читает текст без тегов в формате RTF
lLen = SendMessage(lHwnd, WM_GETTEXTLENGTH, 0, ByVal 0)
ltext = Space(lLen + 1)
ltext = Left(ltext, SendMessage(lHwnd, WM_GETTEXT, lLen + 1, ByVal ltext))
RTFtoTEXT = ltext
Gestion_Erreurs:
' Удаляет контрол
DestroyWindow lHwnd
End Function


Это сообщение отредактировал(а) kuksha - 23.7.2017, 08:53
PM MAIL   Вверх
Google
  Дата 24.9.2017, 11:37 (ссылка)  





  Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Программирование, связанное с MS Office"
mihanik staruha

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами



  • Несанкционированная реклама на форуме запрещена
  • Пожалуйста, давайте своим темам осмысленный, информативный заголовок. Вопль "Помогите!" таковым не является.
  • Чем полнее и яснее Вы изложите проблему, тем быстрее мы её решим.
  • Оставляйте свои записи в "Книге отзывов о работе администрации"
  • А вот тут лежит FAQ нашего подраздела


Если Вам понравилась атмосфера форума, заходите к нам чаще!
С уважением mihanik и staruha.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Программирование, связанное с MS Office | Следующая тема »


 




[ Время генерации скрипта: 0.1119 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.