Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Problème de programmation avec l' API (AnimateWindow)

Problème de programmation avec l' API (AnimateWindow)

5 réponses
Avatar
imej-clavier
Bonjour,
Quelqu'un peut-il comprendre ce qui ne va pas dans mon code ?
J'ai essayé de me servir d'une fonction API (AnimateWindow), mais cela ne
marche pas .
J'ai créé un module dans lequel j'ai mis :
Option Explicit
Private Declare Function AnimateWindow Lib « user32 » ( _
ByVal hwnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) As Long

J'ai créé également un UserForm dans lequel j'ai mis
Private Sub UserForm_Activate()
Debug.Print AnimateWindow(Me.hwnd, 10000, &H10 Or &H20000)
End Sub
J'ai essayé de remplacer le Me par UserForm, mais cela ne change rien.
J'ai démarré le programme à partir du UserForm. Le UserForm s'affiche, mais
sa taille n'est pas
modifiée, alors qu'elle serait censée l'être avec le code de l'API.
D'avance merci,
Jean-michel
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Michel Pierron
Bonsoir imej-clavier;
Dans ton module UserForm, essaie comme ceci:

'Anime la fenêtre de gauche à droite.
Const AW_HOR_POSITIVE = &H1
'Anime la fenêtre de droite à gauche.
Const AW_HOR_NEGATIVE = &H2
'Anime la fenêtre du haut vers le bas.
Const AW_VER_POSITIVE = &H4
'Anime la fenêtre du bas vers le haut.
Const AW_VER_NEGATIVE = &H8
'Réduction vers son centre avec AW_HIDE et inversement avec AW_ACTIVATE.
Const AW_CENTER = &H10
'Cache la fenêtre.
Const AW_HIDE = &H10000
'Active la fenêtre.
Const AW_ACTIVATE = &H20000 'Active la fenêtre.
'Effet de "fondu" (si elle est au premier plan).
Const AW_BLEND = &H80000
'Fait "rouler" la fenêtre.
Const AW_SLIDE = &H40000

Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long _
, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub UserForm_Initialize()
Dim hwnd as long
hwnd = FindWindow(vbNullString, Me.Caption)
AnimateWindow hwnd, 400, AW_VER_POSITIVE Or AW_HOR_POSITIVE Or AW_ACTIVATE
End Sub

MP

"imej-clavier" a écrit dans le message de
news:%
Bonjour,
Quelqu'un peut-il comprendre ce qui ne va pas dans mon code ?
J'ai essayé de me servir d'une fonction API (AnimateWindow), mais cela ne
marche pas .
J'ai créé un module dans lequel j'ai mis :
Option Explicit
Private Declare Function AnimateWindow Lib « user32 » ( _
ByVal hwnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) As Long

J'ai créé également un UserForm dans lequel j'ai mis
Private Sub UserForm_Activate()
Debug.Print AnimateWindow(Me.hwnd, 10000, &H10 Or &H20000)
End Sub
J'ai essayé de remplacer le Me par UserForm, mais cela ne change rien.
J'ai démarré le programme à partir du UserForm. Le UserForm s'affiche,
mais

sa taille n'est pas
modifiée, alors qu'elle serait censée l'être avec le code de l'API.
D'avance merci,
Jean-michel





Avatar
Michel Pierron
Re imej-clavier;
Une chose importante, dans la procédure d'affichage de ton UserForm, il faut
une gestion d'erreur puisque la procédure d'initialisation de l'userform
utilise AW_ACTIVATE et que la feuille modale est déja affichée.
Sub AnimateForm
On Error Resume Next
UserForm1.Show
End Sub

MP

"imej-clavier" a écrit dans le message de
news:%
Bonjour,
Quelqu'un peut-il comprendre ce qui ne va pas dans mon code ?
J'ai essayé de me servir d'une fonction API (AnimateWindow), mais cela ne
marche pas .
J'ai créé un module dans lequel j'ai mis :
Option Explicit
Private Declare Function AnimateWindow Lib « user32 » ( _
ByVal hwnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) As Long

J'ai créé également un UserForm dans lequel j'ai mis
Private Sub UserForm_Activate()
Debug.Print AnimateWindow(Me.hwnd, 10000, &H10 Or &H20000)
End Sub
J'ai essayé de remplacer le Me par UserForm, mais cela ne change rien.
J'ai démarré le programme à partir du UserForm. Le UserForm s'affiche,
mais

sa taille n'est pas
modifiée, alors qu'elle serait censée l'être avec le code de l'API.
D'avance merci,
Jean-michel





Avatar
Michel Pierron
Re imej-clavier;
Tu peux également faire comme ceci:
Dans ton module standard:
Private Declare Function AnimateWindow Lib "user32" (ByVal hWnd As Long _
, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public objForm As UserForm1

Sub RollDiagPos()
Dim hWnd As Long
Set objForm = New UserForm1
objForm.Left = 100: objForm.Top = 100
hWnd = FindWindow(vbNullString, objForm.Caption)
AnimateWindow hWnd, 600, &H1 + &H4 + &H20000
End Sub

Dans ton module UserForm:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set objForm = Nothing
End Sub

MP

"imej-clavier" a écrit dans le message de
news:%
Bonjour,
Quelqu'un peut-il comprendre ce qui ne va pas dans mon code ?
J'ai essayé de me servir d'une fonction API (AnimateWindow), mais cela ne
marche pas .
J'ai créé un module dans lequel j'ai mis :
Option Explicit
Private Declare Function AnimateWindow Lib « user32 » ( _
ByVal hwnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) As Long

J'ai créé également un UserForm dans lequel j'ai mis
Private Sub UserForm_Activate()
Debug.Print AnimateWindow(Me.hwnd, 10000, &H10 Or &H20000)
End Sub
J'ai essayé de remplacer le Me par UserForm, mais cela ne change rien.
J'ai démarré le programme à partir du UserForm. Le UserForm s'affiche,
mais

sa taille n'est pas
modifiée, alors qu'elle serait censée l'être avec le code de l'API.
D'avance merci,
Jean-michel





Avatar
Alain CROS
Bonjour Michel.

Je n'arrive à faire fonctionner aucune de tes propositions.
Le UserForm apparait puis disparait.

Ceci semble fonctionner

Dans le module du UserForm

'Anime la fenêtre de gauche à droite.
Const AW_HOR_POSITIVE = &H1
'Anime la fenêtre de droite à gauche.
Const AW_HOR_NEGATIVE = &H2
'Anime la fenêtre du haut vers le bas.
Const AW_VER_POSITIVE = &H4
'Anime la fenêtre du bas vers le haut.
Const AW_VER_NEGATIVE = &H8
'Réduction vers son centre avec AW_HIDE et inversement avec AW_ACTIVATE.
Const AW_CENTER = &H10
'Cache la fenêtre.
Const AW_HIDE = &H10000
'Active la fenêtre.
Const AW_ACTIVATE = &H20000 'Active la fenêtre.
'Effet de "fondu" (si elle est au premier plan).
Const AW_BLEND = &H80000
'Fait "rouler" la fenêtre.
Const AW_SLIDE = &H40000

Private Declare Function AnimateWindow& Lib "user32" _
(ByVal hwnd&, ByVal dwTime&, ByVal dwFlags&)

Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)

Private Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd&, ByVal nIndex&)

Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)

Private Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)

Private Declare Function ShowWindow& Lib "user32" _
(ByVal hwnd&, ByVal nCmdShow&)

Private BaseWinProc&

Private Sub UserForm_Initialize()
Const GWL_WNDPROC& = -4&
Dim HandleUF&
HandleUF = FindWindow(vbNullString, Me.Caption)
BaseWinProc = GetWindowLong(HandleUF, GWL_WNDPROC)
#If vba6 Then
SetWindowLong HandleUF, GWL_WNDPROC, AddressOf RelaisWinProc
#Else
SetWindowLong HandleUF, GWL_WNDPROC, AddrOf("RelaisWinProc")
#End If
End Sub

Public Function WinProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
Const WM_ACTIVATE& = &H6, GWL_WNDPROC& = -4&
If uMsg = WM_ACTIVATE Then
ShowWindow hwnd, 0&
AnimateWindow hwnd, 400&, AW_VER_POSITIVE Or AW_HOR_POSITIVE Or AW_ACTIVATE
SetWindowLong hwnd, GWL_WNDPROC, BaseWinProc
AppActivate Me.Caption
WinProc = 1&
Exit Function
End If
WinProc = CallWindowProc(BaseWinProc, hwnd, uMsg, wParam, lParam)
End Function

Dans un module standard

Private Declare Function GetCurrentVbaProject& Lib "vba332" _
Alias "EbGetExecutingProj" (hProject&)
Private Declare Function GetFuncID& Lib "vba332" _
Alias "TipGetFunctionId" (ByVal hProject&, _
ByVal strFunctionName$, ByRef strFunctionID$)
Private Declare Function GetAddr& Lib "vba332" _
Alias "TipGetLpfnOfFunctionId" (ByVal hProject&, _
ByVal strFunctionID$, ByRef lpfnAddressOf&)
#If vba6 Then
#Else
Public Function AddrOf&(CallbackFunctionName$)
'AddressOf operator replacement for Office97 VBA
'Authors: Ken Getz and Michael Kaplan
'declaration of local variables
Dim aResult&, CurrentVBProject&, strFunctionID$
Dim AddressOfFunction&, UnicodeFunctionName$
'if the current VBProjects exists...
If GetCurrentVbaProject(CurrentVBProject) = 0 Then Exit Function
'convert the name of the function to Unicode system
UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)
'get the function ID of the callback function, based on its unicode-converted name, _
in order to ensure that it exists
If GetFuncID(CurrentVBProject, UnicodeFunctionName, strFunctionID) = 0 Then
'if the function exists indeed ...
'get a pointer to the callback function based on the strFunctionID argument _
of the GetFuncID function
If GetAddr(CurrentVBProject, strFunctionID, AddressOfFunction) = 0 Then _
AddrOf = AddressOfFunction
'if we've got the pointer pass it to the result of the function
End If
End Function
#End If

Function RelaisWinProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
RelaisWinProc = UserForm1.WinProc(hwnd, uMsg, wParam, lParam)
End Function

Alain CROS
Avatar
Michel Pierron
Bonsoir Alain;
Avec quel OS ?
Chez moi, les 2 fonctionnent avec WinXP et avec Win98, seule la 2ème
proposition fonctionne.
MP

"Alain CROS" a écrit dans le message de
news:%
Bonjour Michel.

Je n'arrive à faire fonctionner aucune de tes propositions.
Le UserForm apparait puis disparait.

Ceci semble fonctionner

Dans le module du UserForm

'Anime la fenêtre de gauche à droite.
Const AW_HOR_POSITIVE = &H1
'Anime la fenêtre de droite à gauche.
Const AW_HOR_NEGATIVE = &H2
'Anime la fenêtre du haut vers le bas.
Const AW_VER_POSITIVE = &H4
'Anime la fenêtre du bas vers le haut.
Const AW_VER_NEGATIVE = &H8
'Réduction vers son centre avec AW_HIDE et inversement avec AW_ACTIVATE.
Const AW_CENTER = &H10
'Cache la fenêtre.
Const AW_HIDE = &H10000
'Active la fenêtre.
Const AW_ACTIVATE = &H20000 'Active la fenêtre.
'Effet de "fondu" (si elle est au premier plan).
Const AW_BLEND = &H80000
'Fait "rouler" la fenêtre.
Const AW_SLIDE = &H40000

Private Declare Function AnimateWindow& Lib "user32" _
(ByVal hwnd&, ByVal dwTime&, ByVal dwFlags&)

Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)

Private Declare Function GetWindowLong& Lib "user32" Alias
"GetWindowLongA" _

(ByVal hwnd&, ByVal nIndex&)

Private Declare Function SetWindowLong& Lib "user32" Alias
"SetWindowLongA" _

(ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)

Private Declare Function CallWindowProc& Lib "user32" Alias
"CallWindowProcA" _

(ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal
lParam&)


Private Declare Function ShowWindow& Lib "user32" _
(ByVal hwnd&, ByVal nCmdShow&)

Private BaseWinProc&

Private Sub UserForm_Initialize()
Const GWL_WNDPROC& = -4&
Dim HandleUF&
HandleUF = FindWindow(vbNullString, Me.Caption)
BaseWinProc = GetWindowLong(HandleUF, GWL_WNDPROC)
#If vba6 Then
SetWindowLong HandleUF, GWL_WNDPROC, AddressOf RelaisWinProc
#Else
SetWindowLong HandleUF, GWL_WNDPROC, AddrOf("RelaisWinProc")
#End If
End Sub

Public Function WinProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal
lParam&)

Const WM_ACTIVATE& = &H6, GWL_WNDPROC& = -4&
If uMsg = WM_ACTIVATE Then
ShowWindow hwnd, 0&
AnimateWindow hwnd, 400&, AW_VER_POSITIVE Or AW_HOR_POSITIVE Or
AW_ACTIVATE

SetWindowLong hwnd, GWL_WNDPROC, BaseWinProc
AppActivate Me.Caption
WinProc = 1&
Exit Function
End If
WinProc = CallWindowProc(BaseWinProc, hwnd, uMsg, wParam, lParam)
End Function

Dans un module standard

Private Declare Function GetCurrentVbaProject& Lib "vba332" _
Alias "EbGetExecutingProj" (hProject&)
Private Declare Function GetFuncID& Lib "vba332" _
Alias "TipGetFunctionId" (ByVal hProject&, _
ByVal strFunctionName$, ByRef strFunctionID$)
Private Declare Function GetAddr& Lib "vba332" _
Alias "TipGetLpfnOfFunctionId" (ByVal hProject&, _
ByVal strFunctionID$, ByRef lpfnAddressOf&)
#If vba6 Then
#Else
Public Function AddrOf&(CallbackFunctionName$)
'AddressOf operator replacement for Office97 VBA
'Authors: Ken Getz and Michael Kaplan
'declaration of local variables
Dim aResult&, CurrentVBProject&, strFunctionID$
Dim AddressOfFunction&, UnicodeFunctionName$
'if the current VBProjects exists...
If GetCurrentVbaProject(CurrentVBProject) = 0 Then Exit Function
'convert the name of the function to Unicode system
UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)
'get the function ID of the callback function, based on its
unicode-converted name, _

in order to ensure that it exists
If GetFuncID(CurrentVBProject, UnicodeFunctionName, strFunctionID) = 0
Then

'if the function exists indeed ...
'get a pointer to the callback function based on the strFunctionID
argument _

of the GetFuncID function
If GetAddr(CurrentVBProject, strFunctionID, AddressOfFunction) = 0
Then _

AddrOf = AddressOfFunction
'if we've got the pointer pass it to the result of the function
End If
End Function
#End If

Function RelaisWinProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal
lParam&)

RelaisWinProc = UserForm1.WinProc(hwnd, uMsg, wParam, lParam)
End Function

Alain CROS