Bouton réduire par macroRésolu

Question

Bonjour à tous,

Ce code, ( grand merci à l'auteur) permet de mettre les bouton "Réduire" et "Agrandir" sur un UserForm... magnifique !
------------------------------------------------------------------------------------------------------------------
Private Declare Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" (ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_Activate()
EnableWindow FindWindowA("XLMAIN", Application.Caption), 1
End Sub
------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
Dim hWnd As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
End Sub
------------------------------------------------------------------------------------------------------------------
Est-ce possible via macro de simuler un click du bouton "Réduire" ?

Je m'explique :
Il y a aussi un bouton "Voir" sur mon UserForm qui sélectionne une autre feuille pour la voir.
Mais je dois chaque fois réduire l'UserForm pour voir la feuille en question.

Donc possible qu'en cliquant sur ce bouton "Voir" qu'il réduise dans la barre des tâches l'UserForm ?

Sans passer par
------------------------------------------------------------------------------------------------------------------
Private Sub Voir_Click()
Sheets("Feuil2").select
End                                                    (Renplacer le End par ?)
End Sub
------------------------------------------------------------------------------------------------------------------
Merci pour votre aide précieuse.

Antoniom.

jmf0 · Accepted Answer

Bonjour,

s'agissant d'un UserForm, essaye ceci, donc (un userForm avec un bouton de commande Command1)

Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type WINDOWPLACEMENT
        Length As Long
        flags As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type
Const ENUM_CURRENT_SETTINGS As Long = -1&
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Private Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private Type monecran
  hauteur As Integer
  largeur As Integer
End Type
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim commeorig As RECT, monhwnd As Long
  
Private Sub Command1_Click()
    Dim WP As WINDOWPLACEMENT
    Dim R As Long
    WP.Length = Len(WP)
    monhwnd = FindWindow(vbNullString, Me.Caption)
    GetWindowPlacement monhwnd, WP
    commeorig = WP.rcNormalPosition
    Dim p As POINTAPI
    p.x = 100
    p.y = 100
    WP.Length = Len(WP)
    WP.showCmd = 6
    WP.ptMinPosition = p
    WP.ptMaxPosition = p
    WP.rcNormalPosition = commeorig
    SetWindowPlacement monhwnd, WP
End Sub


Et sers-t-en, si cela te convient.

cs_antom · Answer

Salut le Forum, Jmf0,

D'abord merci pour ta réponse Jmfo.

Finalement j'ai trouvé en fouillant sur le net cette solution à rajouter dans le code du bouton de sortie :

SendKeys "% u"

Je te laisse le fichier joint pour si ça t'intéresse.

http://www.cijoint.fr/cjlink.php?file=cj200901/cijnklBR7l.xls

Merci encore pour ta contribution.

Antoniom.

Bouton réduire par macro

2 réponses

Votre réponse

Discussions similaires