R
RB Smissaert
Using Word 2002 and 2003.
Trying to put an icon in the titlebar of
a Word userform.
I got code for this that works nicely in Excel, but in Word the icon shows
as an empty space, without the picture.
This is the code I have:
Option Explicit
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName 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
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long) 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 DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
Sub PastePictures()
Dim hIcon
Dim frm As Long
Dim wHandle As Long
On Error Resume Next
If Val(Application.Version) >= 9 Then
wHandle = FindWindow("ThunderDFrame", frmNotes.Caption)
Else
wHandle = FindWindow("ThunderXFrame", frmNotes.Caption)
End If
If wHandle = 0 Then
Exit Sub
Else
hIcon = frmNotes.imgPict.Picture
SendMessage wHandle, &H80, True, hIcon
SendMessage wHandle, &H80, False, hIcon
frm = GetWindowLong(wHandle, -20)
frm = frm And Not &H1
SetWindowLong wHandle, -20, frm
DrawMenuBar wHandle
End If
End Sub
Perhaps one of the API arguments (&H80 or -20) has to be different.
Thanks for any advice.
RBS
Trying to put an icon in the titlebar of
a Word userform.
I got code for this that works nicely in Excel, but in Word the icon shows
as an empty space, without the picture.
This is the code I have:
Option Explicit
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName 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
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long) 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 DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
Sub PastePictures()
Dim hIcon
Dim frm As Long
Dim wHandle As Long
On Error Resume Next
If Val(Application.Version) >= 9 Then
wHandle = FindWindow("ThunderDFrame", frmNotes.Caption)
Else
wHandle = FindWindow("ThunderXFrame", frmNotes.Caption)
End If
If wHandle = 0 Then
Exit Sub
Else
hIcon = frmNotes.imgPict.Picture
SendMessage wHandle, &H80, True, hIcon
SendMessage wHandle, &H80, False, hIcon
frm = GetWindowLong(wHandle, -20)
frm = frm And Not &H1
SetWindowLong wHandle, -20, frm
DrawMenuBar wHandle
End If
End Sub
Perhaps one of the API arguments (&H80 or -20) has to be different.
Thanks for any advice.
RBS