Centrer le userform plein écran [Résolu]

mythiac 72 Messages postés mardi 23 septembre 2008Date d'inscription 23 février 2009 Dernière intervention - 28 nov. 2008 à 15:38 - Dernière réponse : mythiac 72 Messages postés mardi 23 septembre 2008Date d'inscription 23 février 2009 Dernière intervention
- 1 déc. 2008 à 09:56
bonjour,

j'ai un problème j'ai réussi à placer mon userform en plein écran, mais ce n'est pas centré, tout est situé en haut à gauche...

le même problème s'est posé à quelqu'un sur ce lien:

http://www.vbfrance.com/code.aspx?ID=22570

Mais je n'arrive pas à savoir comment faire pour que mon (enfin mes userform car ce sera pour tous!) se placent correctement dès qu'il apparaît...

voici le code actuel:

Option Explicit
Private Declare Sub keybd_event Lib "User32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)

'Fonctions API
Private Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal iditem As Long, ByVal wflags As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow 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 GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function IsIconic Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function IsZoomed Lib "User32" (ByVal hWnd As Long) As Long 'non utilisée ici
Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) 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 Sub ReleaseCapture Lib "User32" ()

'
Private Const SW_MAXIMIZE = 3                   'constantes pour la fonction
Private Const SW_MINIMIZE As Long = 6           'ShowWindow
'
Private Const GWL_STYLE As Long = (-16)         'The offset of a window's style
Private Const WS_MINIMIZEBOX = &H20000          'Style to add a Minimize box on the title bar
Private Const WS_CAPTION As Long = &HC00000     'Style to add a titlebar
'
Private Const SC_MOVE = &HF010                  'constantes
Private Const SC_CLOSE = &HF060                 'pour la fonction
Private Const MF_BYCOMMAND = &H0                'DeleteMenu
'
Private Const WM_NCLBUTTONDOWN = &HA1           'constantes pour
Private Const HTCAPTION = 2                     'déplacement form sans titre
'
Dim hWnd As Long                                'le handle de la form
Dim wInit As Long, hInit As Long                'ses dimensions d'origine
Dim FormInit As Boolean                         'définit l'étape d'initialisation de la form
Dim FormSansTitre As Boolean                    'définit l'étape d'enlèvement du titre
Dim FormST As Boolean                           'definit l'état de la form
Private Sub UserForm_Activate()
    ShowWindow hWnd, SW_MAXIMIZE   'on veut maximiser la form au démarrage,
                                    'ce qui est en fait la raison d'être de ce code...
End Sub

Private Sub UserForm_Initialize()
    Dim iStyle As Long, hMenu As Long
    hWnd = FindWindow(vbNullString, Me.Caption) 'le handle de la form
    hMenu = GetSystemMenu(hWnd, 0)              'le handle du system menu
    iStyle = GetWindowLong(hWnd, GWL_STYLE)     'trouve le style du system menu
    iStyle = iStyle Or WS_MINIMIZEBOX           'ajoute le bouton mimimise
    SetWindowLong hWnd, GWL_STYLE, iStyle       'applique le nouveau style
    DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND    'désactive le bouton supprime    wInit Me.Width: hInit Me.Height
   
    Dim i As Long
i = 2
ComboBox1.Clear

Do Until Feuil4.Range("a" & i).FormulaR1C1 = ""
ComboBox1.AddItem Feuil4.Range("a" & i).FormulaR1C1
i = i + 1
Loop
End Sub

Private Sub CommandButton1_Click()

Dim x As Variant

Dim y As Variant
If ComboBox1.Value <> "" Then
    y = y + 1
    If y > 0 Then
    With Feuil4.Range("a1:a999")
y = Feuil4.Columns("A").Find(ComboBox1.Value, Feuil4.Range("A2")).Row

userform13.TextBox1.Value = Feuil4.Cells(y, 1).Value 'immatriculation
userform13.TextBox2.Value = Feuil4.Cells(y, 2).Value 'marque
userform13.TextBox3.Value = Feuil4.Cells(y, 3).Value 'type
userform13.TextBox4.Value = Feuil4.Cells(y, 4).Value 'modele
userform13.TextBox6.Value = Feuil4.Cells(y, 5).Value 'date 1ere
userform13.TextBox7.Value = Feuil4.Cells(y, 6).Value 'date attrib
userform13.TextBox8.Value = Feuil4.Cells(y, 7).Value 'kilometrage attrib
userform13.TextBox9.Value = Feuil4.Cells(y, 27).Value 'date CONTROLE TECHNIQUE
userform13.TextBox10.Value = Feuil4.Cells(y, 28).Value 'PREVISION CT
userform13.TextBox29.Value = Feuil4.Cells(y, 8).Value 'service
userform13.TextBox11.Value = Feuil4.Cells(y, 12).Value 'n°carte BP1
userform13.TextBox12.Value = Feuil4.Cells(y, 13).Value 'n°carte BP2
userform13.TextBox13.Value = Feuil4.Cells(y, 14).Value 'n°carte BP3
userform13.TextBox14.Value = Feuil4.Cells(y, 15).Value 'n°carte BP4

userform13.TextBox15.Value = Feuil4.Cells(y, 24).Value 'n°code BP
userform13.TextBox16.Value = Feuil4.Cells(y, 16).Value 'n°carte TOTAL1
userform13.TextBox17.Value = Feuil4.Cells(y, 17).Value 'n°carte TOTAL2
userform13.TextBox18.Value = Feuil4.Cells(y, 18).Value 'n°carte TOTAL3
userform13.TextBox19.Value = Feuil4.Cells(y, 19).Value 'n°carte TOTAL4

userform13.TextBox20.Value = Feuil4.Cells(y, 25).Value 'n°code TOTAL
userform13.TextBox21.Value = Feuil4.Cells(y, 20).Value 'n°carte SHEEL1
userform13.TextBox22.Value = Feuil4.Cells(y, 21).Value 'n°carte SHEEL2
userform13.TextBox23.Value = Feuil4.Cells(y, 22).Value 'n°carte SHEEL3
userform13.TextBox24.Value = Feuil4.Cells(y, 23).Value 'n°carte SHEEL4

userform13.TextBox25.Value = Feuil4.Cells(y, 26).Value 'n°code SHEEL
userform13.TextBox28.Value = Feuil4.Cells(y, 29).Value 'Observation

 x = x + 1
 If x > 0 Then
 x = ((Feuil9.Cells(2, 8).Value) - (Feuil4.Cells(y, 5).Value)) 'age vl en jour
    If x < 365 Then
    userform13.TextBox27.Value = "moins d'un an"
    End If
    If x > 364 Then
    userform13.TextBox27.Value = Int(x / 365)
    End If
End If

    If Feuil4.Cells(y, 9).Value = True Then
        userform13.TextBox5.Value = Feuil4.Cells(1, 9).Value
    ElseIf Feuil4.Cells(y, 10).Value = True Then
        userform13.TextBox5.Value = Feuil4.Cells(1, 10).Value
    ElseIf Feuil4.Cells(y, 11).Value = True Then
        userform13.TextBox5.Value = Feuil4.Cells(1, 11).Value
    End If
    End With
    End If
End If

End Sub

 
Private Sub CommandButton2_Click()

Dim Wrd As Object, WrdDoc As Object
 
'Copie d'écran de la forme active
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
 
 
Set Wrd = CreateObject("Word.Application") 'creation session Word
Wrd.Visible = False 'pour que Word reste masqué pendant l'opération
 
On Error Resume Next
Set WrdDoc = Wrd.Documents.Add
WrdDoc.PageSetup.Orientation = 1 ' wdOrientLandscape
 
Wrd.Selection.PasteSpecial 'colle dans le document Word
 
With WrdDoc.Shapes(1) 'redimensionnement et positionnement de l'objet imprimé
.Left = 50 'bord gauche
.Top = 50 'bord haut
.Width = 500
End With
 
WrdDoc.PrintOut 'impression
 
WrdDoc.Close False 'ferme le document Word sans sauvegarde
WrdDoc.Quit 'ferme l'application Word

End Sub

Private Sub TextBox27_Change()

End Sub

'Private Sub UserForm_Initialize()

'End Sub
Private Sub ListBox1_Click()

End Sub

Private Sub TextBox1_Change()

End Sub
Afficher la suite 

Votre réponse

6 réponses

Meilleure réponse
DenisMada 6 Messages postés jeudi 29 mai 2008Date d'inscription 31 décembre 2008 Dernière intervention - 1 déc. 2008 à 06:46
3
Merci
Bonjour
je t'ai mis les signes -+- à chaque fin de ligne. (à supprimer bien sûr !)
je ne sais pas pourquoi la mise en page est mauvaise.
Peut-être due à "Opéra" ??

Application.ScreenUpdating = False-+-
'Déclaration des variables RX et RH-+-
Dim RW As Single, RH As Single-+-

'Calcule le rapport de l'UserForm et la taille de l'écran
RW = ScreenWidth * PointsPerPixel / Me.Width-+-
RH = ScreenHeight * PointsPerPixel / Me.Height-+-

'Met l'UserForm en plein écran-+-
Me.Width = ScreenWidth * PointsPerPixel-+-
Me.Height = ScreenHeight * PointsPerPixel-+-

'Déclaration de la variable Ctl qui correspond aux contrôles
'de ton UserForm-+-
Dim Ctl As MSForms.Control-+-

'Permet de redimensionner tous tes contrôles présent sur-+-
l'UserForm en fonction de la taille de l'userForm et de-+-
la taille de l'écran-+-
For Each Ctl In Me.Controls-+-
Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH-+-
Next-+-
Application.ScreenUpdating = True-+-
Bon courage

Merci DenisMada 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 96 internautes ce mois-ci

Commenter la réponse de DenisMada
DenisMada 6 Messages postés jeudi 29 mai 2008Date d'inscription 31 décembre 2008 Dernière intervention - 28 nov. 2008 à 15:53
0
Merci
Bonjour
mon premier post sur ce forum.
j'espère que je ne suis pas à coté de la question (lol)
tu mes ce code dans ton initialize :
'Déclaration des variables RX et RH
Dim RW As Single, RH As Single

'Calcule le rapport de l'UserForm et la taille de l'écran
RW = ScreenWidth * PointsPerPixel / Me.Width
RH = ScreenHeight * PointsPerPixel / Me.Height

'Met l'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel

'Déclaration de la variable Ctl qui correspond aux contrôles de ton UserForm
Dim Ctl As MSForms.Control

'Permet de redimensionner tous tes contrôles présent sur l'UserForm en fonction de la taille de l'userForm et de la taille de l'écran
For Each Ctl In Me.Controls
Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH
Next

Puis dans un module ceci :
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0 'Screen width
Private Const SM_CYSCREEN = 1 'Screen height

Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hDC As Long) As Long
'
Private Const LOGPIXELSX = 88 'Pixels/inch in X
'
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72

'The width of the screen, in pixels
Public Function ScreenWidth() As Long
ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
End Function

'The height of the screen, in pixels
Public Function ScreenHeight() As Long
ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
End Function

'The size of a pixel, in points
Public Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function

Bon courage et à +
Denis
Commenter la réponse de DenisMada
DenisMada 6 Messages postés jeudi 29 mai 2008Date d'inscription 31 décembre 2008 Dernière intervention - 28 nov. 2008 à 15:54
0
Merci
Désolé pour la mise en page >> c'est loupé
Commenter la réponse de DenisMada
mythiac 72 Messages postés mardi 23 septembre 2008Date d'inscription 23 février 2009 Dernière intervention - 28 nov. 2008 à 16:07
0
Merci
justement, comment places-tu :
For Each Ctl In Me.Controls Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH Next

svp
Commenter la réponse de mythiac
mythiac 72 Messages postés mardi 23 septembre 2008Date d'inscription 23 février 2009 Dernière intervention - 28 nov. 2008 à 16:15
0
Merci
erreurs après placement ainsi, peux tu me dire les fautes...

'Déclaration des variables RX et RH
Dim RW As Single, RH As Single
'Calcule le rapport de l'UserForm et la taille de l'écran
RW = ScreenWidth '* PointsPerPixel /
Me.Width
RH = ScreenHeight '* PointsPerPixel /
Me.Height
'Met l'UserForm en plein écran
Me.Width = ScreenWidth '* PointsPerPixel
Me.Height = ScreenHeight '* PointsPerPixel
'Déclaration de la variable Ctl qui correspond aux contrôles de ton UserForm
Dim Ctl As MSForms.Control
'Permet de redimensionner tous tes contrôles présent sur l'UserForm en fonction de la taille de l'userForm et de la taille de l'écran
For Each Ctl In Me.Controls
Ctl.Move Ctl.Left '*
RW , Ctl.Top '*
RH , Ctl.Width '*
RW , Ctl.Height '*
RH
Next
   
Commenter la réponse de mythiac
mythiac 72 Messages postés mardi 23 septembre 2008Date d'inscription 23 février 2009 Dernière intervention - 1 déc. 2008 à 09:56
0
Merci
merci beaucoup
Commenter la réponse de mythiac

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.