Affichage des l ouverture de mon formulaire en 1280x1024

[ngexcel]

Bonjour à tous
J ai un formulaire en vba je cherche que lorsque l on ouvre
Le fichier. La résolution de l écran passe automatiquement
En 1280x1024 je précise que l écran est en 800x600 pour le poste travail et que la personne
Ne veux pas passer au dessu cause de mal voyance donc je veux juste
Mon fichier

 

[Misange]

Re : Affichage des l ouverture de mon formulaire en 1280x1024

Bonjour
regarde ici
Ce lien n'existe plus
Ce lien n'existe plus


Laurent Longre avait une page sur ce problème sur son site (hors ligne maintenant).
en voici le contenu

Résolution de l'écran

Les fonctions suivantes permettent de lire la résolution actuelle d'affichage et le nombre de couleurs (LireRes), ainsi que modifier ces deux paramètres (ChangeRes).
- LireRes(HorzPix As Integer, BitsPerPel As Integer) : cette procédure renvoie dans les variable HorzPix et VertPix respectivement la largeur et la hauteur de la résolution actuelle en nombre de pixels -par exemple 640 et 480- et dans la variable BitsPerPel le nombre de couleurs supporté, en puissance de 2 -par exemple 24 si le nombre de couleurs est 16 777 216 (2[SUP]24[/SUP]).
Exemple d'utilisation :

Dim HorzPix As Integer, VertPix As Integer, BitsPerPel As Integer LireRes HorzPix, VertPix, BitsPerPel MsgBox "La résolution actuelle est " & HorzPix & " x " _ & VertPix & " en " & 2 ^ BitsPerPel & " couleurs.", vbInformation - ChangeRes([HorzPix][, BitsPerPel]) change la résolution en fonction de la largeur demandée en pixels (paramètre HorzPix, par exemple 800 ou 1024) et du nombre de couleurs en puissance de 2 (par exemple 16 si l'on veut un affichage à 65 536 couleurs). Si l'un des deux arguments est manquant, la résolution actuelle ou le nombre de couleurs actuel est conservé.
Cette fonction renvoie :
. 0 si la résolution demandée est la même que ma résolution actuelle.
. 1 si la résolution a pu être modifiée dynamiquement.
. 2 si le changement de résolution nécessite un redémarrage du système.
. -1 si la résolution est théoriquement supportée mais Windows n'arrive pas à l'appliquer.
. -2 si la résolution demandée n'est pas supportée.
La procédure ChangerRésolution ci-dessous propose de redémarrer automatiquement le système (via la fonction API ExitWindowsEx) si le changement des paramètres d'affichage le nécessite.

Type TDEVMODE
  dmDeviceName As String * 32
  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 * 32
  dmUnusedPadding As Integer
  dmBitsPerPel As Integer
  dmPelsWidth As Long
  dmPelsHeight As Long
  dmDisplayFlags As Long
  dmDisplayFrequency As Long
End Type

Private Declare Function EnumDisplaySettingsA Lib "User32" _
  (ByVal lpszDeviceName As String, ByVal iModeNum As Long, _
  lpDevMode As TDEVMODE) As Long

Private Declare Function ChangeDisplaySettingsA Lib "User32" _
  (lpDevMode As TDEVMODE, ByVal dwflags As Long) As Long

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

Declare Function ExitWindowsEx Lib "User32" _
  (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

'____________________________________________________________

Private Sub LireRes(Optional HorzPix, Optional VertPix, _
  Optional BitsPerPel)

  Dim DC As Long

  DC = GetDC(0)
  HorzPix = GetDeviceCaps(DC, 8)
  VertPix = GetDeviceCaps(DC, 10)
  BitsPerPel = GetDeviceCaps(DC, 12)
  ReleaseDC 0, DC

End Sub

'____________________________________________________________

Private Function ChangeRes(Optional HorzPix, _
Optional BitsPerPel) As Integer

  Dim DevMode As TDEVMODE, I As Long
  Dim ActBitsPerPel As Integer, ActHorzPix As Integer

  LireRes ActHorzPix, , ActBitsPerPel
  If IsMissing(HorzPix) Then HorzPix = ActHorzPix
  If IsMissing(BitsPerPel) Then BitsPerPel = ActBitsPerPel
  If HorzPix = ActHorzPix And BitsPerPel = ActBitsPerPel _
    Then Exit Function
  Do
    If EnumDisplaySettingsA(vbNullString, I, DevMode) = 0 _
      Then ChangeRes = -2: Exit Function
    I = I + 1
  Loop Until DevMode.dmPelsWidth = HorzPix _
    And DevMode.dmBitsPerPel = BitsPerPel
  ChangeRes = ChangeDisplaySettingsA(DevMode, 0)
  If ChangeRes = 1 Then ChangeRes = ChangeDisplaySettingsA(DevMode, 1)
  If ChangeRes >= 0 Then ChangeRes = ChangeRes + 1

End Function

'____________________________________________________________

Sub ChangerRésolution()

  ' Tente de passer en résolution 800 x 600 et 65 536 couleurs

  Dim Rep As Long

  Select Case ChangeRes(800, 16)  ' (65 536 = 2^16)
    Case 0
      MsgBox "Aucun changement de résolution nécessaire."
    Case 1
      MsgBox "Résolution modifiée."
    Case 2
      Rep = MsgBox("Vous devez redémarrer votre ordinateur " _
        & "pour que les changements prennent effet." & vbLf$ & _
        "Voulez-vous redémarrer maintenant ?", vbYesNo + vbInformation)
      If Rep = vbYes Then ExitWindowsEx 2, 0
    Case -1
      MsgBox "Impossible de changer de résolution."
    Case -2
      MsgBox "Résolution et / ou nombre de couleurs non supporté."
  End Select

End Sub