powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как поставить свою иконку в msgbox?
67 сообщений из 67, показаны все 3 страниц
Как поставить свою иконку в msgbox?
    #36925747
Armani
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В свойствах вроде ее не установишь. Новую форму рисовать или можно как-то сделать?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36925790
Armani
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Аналогичный вопрос и по inputbox, а то во всех формах есть иконки , а тут нет.
Нашел вариант, не знаю правда рабочий или нет на дельфи, может кто знает как переделать под бейсик

function MessageBoxIndirect(const MsgBoxParams: TMsgBoxParams): Integer; stdcall; external user32 name 'MessageBoxIndirectA';

function MessageBoxWithIcon(hWnd: HWND; const lpText, lpCaption: string; uType: DWORD; szIcon: PWChar): Integer;
var
mbp: TMsgBoxParams;
begin
ZeroMemory(@mbp, SizeOf(mbp));
with mbp do
begin
cbSize := SizeOf(mbp);
hwndOwner := hWnd;
hInstance := SysInit.HInstance;
lpszText := PChar(lpText);
lpszCaption := PChar(lpCaption);
PWChar(lpszIcon) := szIcon;
dwStyle := uType;
end;
Result := MessageBoxIndirect(mbp);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MessageBoxWithIcon(Handle, 'Привет', 'Сообщение с иконкой!', MB_USERICON or MB_APPLMODAL, 'MAINICON');
end;
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36925832
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
работает только в скомпилированном exe. из отладки иконку не увидишь!
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926130
Armani
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Konst_one, спасибо большое, получилось.
А еще такой вопрос, можно еще сделать такой вариант, чтобы иконка была не на самом msgbox, а такая же например, как у вашей основной Form1, в заголовке?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926322
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
добавьте в ресурсный файл любую нужную вам иконку а потом просто укажите номер вашего ресурса:

Код: plaintext
1.
2.
...
MB.lpszIcon =  101  'номер ресурса иконки
...
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926420
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Konst_One, я так понял, а в ВБА это всё проделать не возможно????
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926603
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

В ПРИНЦИПЕ МОЖНО И В vba ВСТАВИТЬ СВОЮ ИКОНКУ

ДОМА ГДЕ ТО ЕСТЬ ПРИМЕРЫ СО ВСТАВКОЙ СВОЕЙ ИКОНКИ В msgbox
И ВРОДЕ РАБОТАЛО В РЕЖИМЕ ОТЛАДКИ
НАДО ПОИСКАТЬ
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926613
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, подожду
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926804
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

вот пример
правда я не пробовал делать это в VBA
хотя думаю должно работать
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36927883
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

пример работает и в VBA Excel
можно иконки загружать через loadPicture()
немного меняется модуль

у меня теперь вопрос к тебе
как можно в VBA вставить редактор ресурсов ?
именно редактор а не готовый файл
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928616
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, что такое редактор ресурсов?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928708
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю,

У меня на русском: Добавления-Менеджер дополнений. Находишь VB6 Resources Editor-Выделяешь-галка Загрузить/Выгрузить. Если надо загружать каждый раз - Загружать при запуске.

Для английской версии на память:
Add-Ins-Add-In Manager-VB6 Resource Editor. Для загрузки - Loaded/Unloaded, для загрузки при запуске - Load on Startup
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928712
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

не заморачивайся с ресурсами
вещь хорошая но в VB жутко ограниченная

в VBA вообще такой вещи нет
я не нашёл
просто интересно было можно ли такую вещь забацать в виде настройки для VBA
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928718
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, я и не заморачиваюсь, Вы сами спрашиваете, сами отвечаете
Вы можете выложить код на ВБА?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928761
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
эээээ

какой именно код ?
про MSGBOX или с файлом ресурсов

второго у меня нету
первый счас подделаю и выставлю
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928783
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

вот VBA код

иконки берутся из текущей директории
через loadPicture

в модуле основная обработка

sheet1
sub main ()
сам запуск в коде
несколько примеров
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928786
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, нет не код про MSGBOX, а код про MsgBox $
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928787
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ваш пост до моего ещё не видел, посмотрю
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928789
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
вус из дус MsgBox$ ?

у меня такого не было
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928791
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Да Вы можете выложить понятно, Эксель вообще не перевариваю
Чтобы в Ворде Ваш скрипт
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub main()

MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ), LoadPicture(ActiveWorkbook.Path & "\critical.ico")
MsgBoxEx "Test2", vbInformation, "Test!", Val( 250 ), Val( 250 ), LoadPicture(ActiveWorkbook.Path & "\exclamation.ico")
MsgBoxEx "Test3", vbInformation, "Test!", Val( 300 ), Val( 300 ), LoadPicture(ActiveWorkbook.Path & "\information.ico")
MsgBoxEx "Test4", vbInformation, "Test!", Val( 350 ), Val( 350 ), LoadPicture(ActiveWorkbook.Path & "\pbxpicon.ico")
MsgBoxEx "Test5", vbInformation, "Test!", Val( 400 ), Val( 400 ), LoadPicture(ActiveWorkbook.Path & "\question.ico")
MsgBoxEx "Right to Left Text", vbMsgBoxRight + vbMsgBoxRtlReading, "Test!", Val( 450 ), Val( 450 ), LoadPicture(ActiveWorkbook.Path & "\swvb.ico")

End Sub
заработал, что надо кроме него???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928792
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ну может получение пути для картинки поменять надо
там вроде по другому
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928800
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю ДЛЯ WORD


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub main()
MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ), LoadPicture(ThisDocument.Path & "\critical.ico")
MsgBoxEx "Test2", vbInformation, "Test!", Val( 250 ), Val( 250 ), LoadPicture(ThisDocument.Path & "\exclamation.ico")
MsgBoxEx "Test3", vbInformation, "Test!", Val( 300 ), Val( 300 ), LoadPicture(ThisDocument.Path & "\information.ico")
MsgBoxEx "Test4", vbInformation, "Test!", Val( 350 ), Val( 350 ), LoadPicture(ThisDocument.Path & "\pbxpicon.ico")
MsgBoxEx "Test5", vbInformation, "Test!", Val( 400 ), Val( 400 ), LoadPicture(ThisDocument.Path & "\question.ico")
MsgBoxEx "Right to Left Text", vbMsgBoxRight + vbMsgBoxRtlReading, "Test!", Val( 450 ), Val( 450 ), LoadPicture(ThisDocument.Path & "\swvb.ico")


End Sub


модуль
единственная заморочка
строчка
Title = "word" 'application.Title
я не знаю как получить Title открытой страницы
это в случае если Title не выставлен по умолчаению

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
'Win32 API decs

'Hook functions
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) 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

'Constants
Private Const WH_CBT            As Long =  5 
Private Const HCBT_ACTIVATE     As Long =  5 
Private Const HWND_TOP          As Long =  0 
Private Const SWP_NOSIZE        As Long = &H1
Private Const SWP_NOZORDER      As Long = &H4
Private Const SWP_NOACTIVATE    As Long = &H10
Private Const STM_SETICON       As Long = &H170

'APP-SPECIFIC
Private Const SWVB_DEFAULT      As Long = &HFFFFFFFF '-1 is reserved for centering
Private Const SWVB_CAPTION_DEFAULT As String = "SWVB_DEFAULT_TO_APP_TITLE"

'Types
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

'module-level member variables
Private m_Hook As Long
Private m_Left As Long
Private m_Top As Long
Private m_hIcon As Long

Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Dim hInstance As Long


Public Function MsgBoxEx(ByVal Prompt As String, _
                Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                Optional ByVal Title As String = SWVB_CAPTION_DEFAULT, _
                Optional ByVal Left As Long = SWVB_DEFAULT, _
                Optional ByVal Top As Long = SWVB_DEFAULT, _
                Optional ByVal Icon As Long =  0 &) As VbMsgBoxResult

Dim hInst As Long
Dim threadID As Long
Dim wndRect As RECT

hInstance = GetModuleHandle("WINWORD.EXE")


hInst = hInstance 'Application.hInstance
threadID = GetCurrentThreadId()

'First "subclass" the MsgBox function
m_Hook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHook, hInst, threadID)

'Save the new arguments as member variables to be used from the MsgBoxHook proc
m_Left = Left
m_Top = Top
m_hIcon = Icon
    
'default the msgBox caption to app.title
If Title = SWVB_CAPTION_DEFAULT Then
    Title = "word" 'application.Title
End If

'if user wants custom icon make sure dialog has an icon to replace
If m_hIcon <>  0 & Then
    Buttons = Buttons Or vbInformation
End If
'show the MsgBox and let hook proc take care of the rest...
MsgBoxEx = MsgBox(Prompt, Buttons, Title)

End Function

Private Function MsgBoxHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim height As Long
Dim width As Long
Dim nSize As Long
Dim wndRect As RECT
Dim sBuffer As String
Dim fWidth As Long
Dim fHeight As Long
Dim x As Long
Dim y As Long
Dim hIconWnd As Long

Debug.Print "hook proc called"
'Call next hook in the chain and return the value
'(this is the polite way to allow other hhoks to function too)
MsgBoxHook = CallNextHookEx(m_Hook, nCode, wParam, lParam)

' hook only the activate msg
If nCode = HCBT_ACTIVATE Then
    'handle only standard MsgBox class windows
    sBuffer = Space$( 32 ) 'this is the most efficient method to allocate strings in VB
                         'according to Brad Martinez's results with tools from NuMega
    nSize = GetClassName(wParam, sBuffer,  32 ) 'GetClassName will truncate the class name if it doesn't fit in the buffer
                                              'we only care about the first 6 chars anyway
    If Left$(sBuffer, nSize) <> "#32770" Then
        Exit Function 'not a standard msgBox
                      'we can just quit because we already called CallNextHookEx
    End If
     
    'store MsgBox window size in case we need it
    Call GetWindowRect(wParam, wndRect)
    'handle divide by zero errors (should never happen)
    On Error GoTo errorTrap
    height = (wndRect.Bottom - wndRect.Top) /  2 
    width = (wndRect.Right - wndRect.Left) /  2 
    
    'store parent window size
    Call GetWindowRect(GetParent(wParam), wndRect)
    'handle divide by zero errors (should never happen)
    On Error GoTo errorTrap
    fHeight = wndRect.Top + (wndRect.Bottom - wndRect.Top) /  2 
    fWidth = wndRect.Left + (wndRect.Right - wndRect.Left) /  2 
    
    'By default center MsgBox on the form
    'if user passed in specific values then use those instead
    If m_Left = SWVB_DEFAULT Then 'default
        x = fWidth - width
    Else
        x = m_Left
    End If
    
    If m_Top = SWVB_DEFAULT Then 'default
        y = fHeight - height
    Else
        y = m_Top
    End If

    'Manually set the MsgBox window position before Windows shows it
    SetWindowPos wParam, HWND_TOP, x, y,  0 ,  0 , SWP_NOSIZE + SWP_NOZORDER + SWP_NOACTIVATE

    'If user passed in custom icon use that instead of the standard Windows icon
    If m_hIcon <>  0 & Then
        hIconWnd = FindWindowEx(wParam,  0 &, "Static", vbNullString)
        Call SendMessage(hIconWnd, STM_SETICON, m_hIcon, ByVal  0 &)
    End If

errorTrap:
    'unhook the dialog and we are out clean!
    UnhookWindowsHookEx m_Hook
    Debug.Print "unhook"
End If

End Function
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928818
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R,

спасибо, тогда например так:

Код: plaintext
1.
MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ), LoadPicture("C:\Documents and Settings\user1\Мои документы\Новая папка (2)\MSGBOX_ICON" & "\critical.ico")
Ранее я Вам толковал, что в ВБА лучше писать MsgBox$ чем MsgBox
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928827
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
в этой строке
Код: plaintext
1.
MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ).....
Val(200) это вероятно отступы??
Первый от чего???
Второй от чего???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928831
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Val(200), Val(200)

---------------------------------------------
позиция на экране координаты X Y
или лучше брать координаты относительно самого экрана только по центру
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928833
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович ЭндрюПервый от чего???
Второй от чего???
Первый ось икс
Второй ось игрек
Так????
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928835
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Первый ось икс
Второй ось игрек
Так????

----------------------------------------------------------
угу!!!!!!!
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928838
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R,

всё понял, честно говоря муторно, это камень в огород ВБА, чтобы такую плёвую задачу решить столько строк кода!!!!!!!!!!
Всё ничего, но например к 2020 году они поймут, что люди хотят ставить свою иконку
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928844
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
так напиши свою модальную форму которая и будет
твоим собственным MSGBOX-ом со всеми прибамбахами
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928849
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, так то оно так, можно написать, но вопрос в силе: к 2020 году они поймут, что люди хотят ставить свою иконку
Точно также как есть возможность выбрать из насколько я помню штук из 5-6
Критикал
Информатион
и т. д.
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928854
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ну много чего можно добавлять
к MessageBox

языки для кнопок
задержка показа на экране
шрифты
.....
есть примерчики на API для изменения таких свойств
ну это скорее украшательство
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928862
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R,

так я про это и говорю, что от них требуется:
Код: plaintext
1.
MsgBox "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ), LoadPicture("C:\Documents and Settings\user1\Мои документы\Новая папка (2)\MSGBOX_ICON" & "\critical.ico"), Ариал,  12 , курсив, жирный, подчёркнутый
Одна строка и вся любовь
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928863
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
все вопросы в Microsoft
в технический отдел
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928866
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael Rвсе вопросы в Microsoft
в технический отдел
к 2020 году они поймут, что люди хотят ставить свою иконку, шрифт, размер шрифта, цвет шрифта, и т. д.?????
Если бы всё было и форум был бы не нужен!!!!!!
По многои вопросам, в частности по этому
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928885
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
скучно станет жить на свете
если микрософт будет думать за нас
как сковородка тефаль
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929068
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, что-то всё вроде просто, но по аналогии не смог сделать это жк с ИнпутБоксом, можно ли? и как?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929108
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
а разве в inputBox есть иконка ?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929159
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, понял, что никак, опять ждать как минимум до 2020 г. Медленные они там все, нет иконки, забацали
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929225
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
посмотрю можно ли вообще
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929667
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R,

Вот чудеса, решил сделать проверку наличия загружаемой картинки, имею:
Код: plaintext
1.
2.
3.
4.
5.
6.
On Error Resume Next
MsgBoxEx "Test1", vbInformation, "Test!", Val( 250 ), Val( 250 ), LoadPicture("C:\Documents and Settings\user1\Мои документы\Новая папка (6662)\MSGBOX_ICON" & "\exclamation.ico")
'условие, если произошла ошибка № 76, когда загружаемый файл где находится иконка не найден, тогда показываем MsgBox без иконки
If Err.Number =  76  Then MsgBox$ "Test1", "Test!" 'не показывает???? почему??????7
MsgBox$ "Говорит Германия", vbInformation, "Внимание" 'показывает!!!!!!!!!

...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929731
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
не фига не понял
что показывается а что не показывается
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929734
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Эндрю
ну ты фамилию то не позорь


If Err.Number = 76 Then MsgBox$ "Test1", "Test!" 'не показывает???? почему??????7

а где vbinfomation ?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929750
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, спасибо, что говорится глаз замылился
или ещё vbOKOnly добавить, то есть:
Код: plaintext
1.
2.
3.
4.
5.
6.
On Error Resume Next
MsgBoxEx "Test1", vbInformation, "Test!", Val( 250 ), Val( 250 ), LoadPicture("C:\Documents and Settings\user1\Мои документы\Новая папка (6662)\MSGBOX_ICON" & "\exclamation.ico")
'условие, если произошла ошибка № 76, когда загружаемый файл где находится иконка не найден, тогда ... показываем MsgBox без иконки
If Err.Number =  76  Then MsgBox$ "Test1", vbInformation, "Test!" 'с иконкой Ворда
'или
If Err.Number =  76  Then MsgBox$ "Test1", vbOKOnly, "Test!" 'без иконки
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929752
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
поэтому я и писал про файл ресурсов
что ресурсы (картинки) были в самом проекте
без проверок на путь к файлу

но в VBA почему то такого нету
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929753
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, ну ничего хоть в конце темы но понял Ваш вопрос
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929755
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R
но в VBA почему то такого нету
Ответ тот же самый будем ждать примерно до 2020 г., то ли ещё будет, ВБА его знает
Там у них есть естественно цех, отдел ли по постановке задач, я бы там бесплатно работал!!!!!!!
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929757
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Эндрю
насчёт InputBox

нет не нашёл как вставить иконку

можно издевать над другими вещами там
например с текстовым полем
но про иконку ничего нету
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929761
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael RЭндрю
насчёт InputBox

можно издевать над другими вещами там
например с текстовым полем

Выложите скрипт, пжл
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36929764
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
дома
вечером
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930198
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Эндрю

вот пример на inputbox

но там картинка не работает
хоть и стоит параметром в функции
в самой функции код для картинки тоже не работает

можно ещё добавить сообщений для текстового поля в inputbox
чисто для расширения возможностей

но мне честно говоря лень
описания для этих сообщений есть в модуле
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930275
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael Rнасчёт InputBox
можно издевать над другими вещами там
например с текстовым полем


Честно говоря не понял, где там и что можно менять:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetDlgItem Lib "user32.dll" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) 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
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

                                    
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const EM_LIMITTEXT As Long = &HC5
Private Const WH_CBT =  5 
Private Const HCBT_ACTIVATE =  5 
Private Const HC_ACTION =  0 
Private Const GWL_STYLE = (- 16 )


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const ES_NUMBER = &H2000
Private Const ES_CENTER As Long = &H1&
Private Const ES_LEFT As Long = &H0&
Private Const ES_LOWERCASE As Long = &H10&
Private Const ES_RIGHT As Long = &H2&
Private Const ES_UPPERCASE As Long = &H8&
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const STM_SETICON       As Long = &H170
Private Const WM_SETICON As Long = &H80



Private hHook     As Long
Private lMaxLen   As Long
Private lPassChar As Long
Private bNumbersOnly As Boolean
Private m_hIcon As Long
Private m_Title As String


Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
    Dim RetVal As Long
    Dim strClassName As String
    Dim lngBuffer As Long
    Dim lWnd As Long
    
    '''''''''''''''''''''''''''''''''''''''''''''''
    Dim hIconWnd As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''
    
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)

        Exit Function

    End If

    strClassName = String$( 256 , " ")
    lngBuffer =  255 

    If lngCode = HCBT_ACTIVATE Then
    
        RetVal = GetClassName(wParam, strClassName, lngBuffer)

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If m_hIcon <>  0 & Then
         hIconWnd = FindWindow(vbNullString, m_Title)
        Call SendMessage(hIconWnd, WM_SETICON, m_hIcon, ByVal  0 &)
        'Call SendDlgItemMessage(hIconWnd, &H1324, WM_SETICON, m_hIcon, &H0)
        
    End If ''''''''''''''''''''''''''''''''''''''''''''''



        If Left$(strClassName, RetVal) = "#32770" Then
        
        
        
        
            If lPassChar >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, lPassChar, &H0
            End If

            If lMaxLen >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_LIMITTEXT, lMaxLen, &H0
            End If

            If bNumbersOnly Then
                lWnd = GetDlgItem(wParam, &H1324)
                If Not lWnd =  0  Then
                    SetWindowLong lWnd, GWL_STYLE, GetWindowLong(lWnd, GWL_STYLE) Or ES_NUMBER  '  Or ES_RIGHT  ' or ES_CENTER ' or ES_LEFT ' or  ES_LOWERCASE  ' or  ES_UPPERCASE
                End If
            End If
            
            
        End If
    End If
    
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxEx(Prompt As String, _
                           Optional Title As String = "", _
                           Optional Default As String = "", _
                           Optional XPos, _
                           Optional YPos, _
                           Optional HelpFile, _
                           Optional Context, _
                           Optional MaxLen As Long =  0 , _
                           Optional PasswordChar As String = "", _
                           Optional NumbersOnly As Boolean = False, _
                           Optional ByRef CancelledByUser As Boolean = False, _
                           Optional ByVal Icon As Long =  0 &) As String
                            
    Dim lngModHwnd As Long
    Dim lngThreadID As Long

    hHook =  0 
    lMaxLen =  0 
    lPassChar =  0 
    bNumbersOnly = NumbersOnly
    m_hIcon = Icon
    
    If MaxLen >  0  Then
        lMaxLen = MaxLen
    End If

    If Not PasswordChar = "" Then
        lPassChar = Asc(PasswordChar)
    End If

    
    If lPassChar >  0  Or lMaxLen >  0  Or bNumbersOnly = True Then
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    End If

    m_Title = Title
    InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)

    If Not hHook =  0  Then
        UnhookWindowsHookEx hHook
    End If
    
    CancelledByUser = (StrPtr(InputBoxEx) =  0 )

End Function

Sub Поле_ввода_InputBox()

Параметр =  11 
InputBoxEx (Параметр)

End Sub
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930278
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
' Or ES_RIGHT ' or ES_CENTER ' or ES_LEFT ' or ES_LOWERCASE ' or ES_UPPERCASE

эти описания

ES_RIGHT текст записывается справо налево (иврит арабский)
ES_CENTER текст по центру
ES_LEFT текст слева
ES_LOWERCASE буквы всегда записываются в нижнем регистре
ES_UPPERCASE буквы всегда записываются в верхнем регистре
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930282
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
исходные примеры

1 писать только цифры
2 знаки ограниченное количество
3 текст записывается как пароль со звёздочками
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930307
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael Rисходные примеры

1 писать только цифры
2 знаки ограниченное количество
3 текст записывается как пароль со звёздочками

Не понял, где они??
Сейчас там стоит Or ES_NUMBER
И почему то я могу в поле вводить и буквы???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930309
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
и что то нет заголовка у поля Инпутбокс, как оно ставится???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930356
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
и можно ли убрать и как снопку Саnсel???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930447
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Эндрю


ну БеХаеха
зачем фамилию позоришь


ЭндрюНе понял, где они??
Сейчас там стоит Or ES_NUMBER
И почему то я могу в поле вводить и буквы???

вместо ES_NUMBER поставь другие сообщения
как пример

в примере с цифрами можно вводить только цифры



Эндрюи что то нет заголовка у поля Инпутбокс, как оно ставится???
в Button_click и меняется заголовок


Эндрюи можно ли убрать и как снопку Саnсel???
вот не знаю зачем тебе такое извращение
даже никогда и не думал об этом
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930455
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R
в примере с цифрами можно вводить только цифры


Так я же говорю, что там стоит Or ES_NUMBER, я иогу ввести например букву "Ж"

michael Rможно ли убрать и как снопку Саnсel???
вот не знаю зачем тебе такое извращение
даже никогда и не думал об этом
Так я ж почти работаю в Микрософте в цехе постановки задач
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930479
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Так я же говорю, что там стоит Or ES_NUMBER, я иогу ввести например букву "Ж"


нет только цифры
или у тебя винда другая
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938776
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, ответьте пжл на мой пост от 1 ноя 10, 02:06, спасибо
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938787
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю


отвечаю ещё раз
в том примере что я тебе дал у меня
в inputBox с цифрами можно писать только цифры
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938793
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, то есть я правильно понял, у Вас в окно ввода Инпут бокса буквы нельзя ввести, и что какая реакция, звук, сообщение?
Но у меня можно ввести и никакой реакции со стороны ВБА!
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938837
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
проверяй модуль
и значения на API константы
это должно работать
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938877
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, Вы имеете ввиду строку скрипта: Private Const ES_NUMBER = &H2000
Если к константе ES_NUMBER подвести курсор будет 8192
Правильно или нет ВБА его знает???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36939065
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Эндрю ещё раз

это вызов
Код: plaintext
1.
2.
3.
4.
5.
Sub main()
Dim s As String
Dim bCanc As Boolean
s = InputBoxEx("Enter a number (10 digits max)", "InputboxEx", , , , , ,  10 , , True, bCanc)
End Sub


это модуль
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
Option Explicit

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetDlgItem Lib "user32.dll" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) 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
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

                                    
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const EM_LIMITTEXT As Long = &HC5
Private Const WH_CBT =  5 
Private Const HCBT_ACTIVATE =  5 
Private Const HC_ACTION =  0 
Private Const GWL_STYLE = (- 16 )


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const ES_NUMBER = &H2000
Private Const ES_CENTER As Long = &H1&
Private Const ES_LEFT As Long = &H0&
Private Const ES_LOWERCASE As Long = &H10&
Private Const ES_RIGHT As Long = &H2&
Private Const ES_UPPERCASE As Long = &H8&
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const STM_SETICON       As Long = &H170
Private Const WM_SETICON As Long = &H80



Private hHook     As Long
Private lMaxLen   As Long
Private lPassChar As Long
Private bNumbersOnly As Boolean
Private m_hIcon As Long
Private m_Title As String


Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
    Dim RetVal As Long
    Dim strClassName As String
    Dim lngBuffer As Long
    Dim lWnd As Long
    
    '''''''''''''''''''''''''''''''''''''''''''''''
    Dim hIconWnd As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''
    
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)

        Exit Function

    End If

    strClassName = String$( 256 , " ")
    lngBuffer =  255 

    If lngCode = HCBT_ACTIVATE Then
    
        RetVal = GetClassName(wParam, strClassName, lngBuffer)

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If m_hIcon <>  0 & Then
         hIconWnd = FindWindow(vbNullString, m_Title)
        Call SendMessage(hIconWnd, WM_SETICON, m_hIcon, ByVal  0 &)
        'Call SendDlgItemMessage(hIconWnd, &H1324, WM_SETICON, m_hIcon, &H0)
        
    End If ''''''''''''''''''''''''''''''''''''''''''''''



        If Left$(strClassName, RetVal) = "#32770" Then
        
        
        
        
            If lPassChar >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, lPassChar, &H0
            End If

            If lMaxLen >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_LIMITTEXT, lMaxLen, &H0
            End If

            If bNumbersOnly Then
                lWnd = GetDlgItem(wParam, &H1324)
                If Not lWnd =  0  Then
                    SetWindowLong lWnd, GWL_STYLE, GetWindowLong(lWnd, GWL_STYLE) Or ES_NUMBER  '  Or ES_RIGHT  ' or ES_CENTER ' or ES_LEFT ' or  ES_LOWERCASE  ' or  ES_UPPERCASE
                End If
            End If
            
            
        End If
    End If
    
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxEx(Prompt As String, _
                           Optional Title As String = "", _
                           Optional Default As String = "", _
                           Optional XPos, _
                           Optional YPos, _
                           Optional HelpFile, _
                           Optional Context, _
                           Optional MaxLen As Long =  0 , _
                           Optional PasswordChar As String = "", _
                           Optional NumbersOnly As Boolean = False, _
                           Optional ByRef CancelledByUser As Boolean = False, _
                           Optional ByVal Icon As Long =  0 &) As String
                            
    Dim lngModHwnd As Long
    Dim lngThreadID As Long

    hHook =  0 
    lMaxLen =  0 
    lPassChar =  0 
    bNumbersOnly = NumbersOnly
    m_hIcon = Icon
    
    If MaxLen >  0  Then
        lMaxLen = MaxLen
    End If

    If Not PasswordChar = "" Then
        lPassChar = Asc(PasswordChar)
    End If

    
    If lPassChar >  0  Or lMaxLen >  0  Or bNumbersOnly = True Then
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    End If

    m_Title = Title
    InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)

    If Not hHook =  0  Then
        UnhookWindowsHookEx hHook
    End If
    
    CancelledByUser = (StrPtr(InputBoxEx) =  0 )

End Function

у меня в VBA WORD работает
только цифры
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36939911
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R,

спасибо!!!!, теперь работает, я сильно не вникал, что ранее было не так
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36940646
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, хотел спросить, когда указано вводить цифры, а я ввожу букву происходит звук, но в коде Beep нет, откуда он берётся? и можно ли и как вместо него например заголовок ИнпутБокса менять?????
...
Рейтинг: 0 / 0
67 сообщений из 67, показаны все 3 страниц
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как поставить свою иконку в msgbox?
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]