changt résolution écran

bonjour à tous
il y a pas mal de temps on m'a donné, ici, les elements suivants pour
changer par VBA sur n'importe quelle machine, la résolution de l'écran... ça
marchait

j'ai du en perdre une partie parce que , sur w98, quand je passe de 850x600
à 1024 x768 la barre de taches se retrouve au milieu de l'écran.. et peut
être que ça crée d'autres désagréments... car excel se conduit assez
bizarrement, vba n'est pas stable... (mon logiciel comporte 4500 lignes... et
marchais bien jusqu'à maintenant)

voici mon code :

Option Explicit

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
dmdDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmForName As String * 32
dmUnusedPadding As Integer
dmBitsPerpel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDispayFlags 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
Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Function ChangeRes(Optional NewHorzpix, Optional NewVertpix,
Optional NewBitsPerPel) As Integer
Dim DevMode As TDEVMODE, i As Long
Dim HHorzpix As Integer, Vvertpix As Integer, BBitsPerPel As Integer
Dim DC As Long

' situation actuelle
DC = GetDC(0)
HHorzpix = GetDeviceCaps(DC, 8)
Vvertpix = GetDeviceCaps(DC, 10)
BBitsPerPel = GetDeviceCaps(DC, 12)
ReleaseDC 0, DC

If IsMissing(NewHorzpix) Then NewHorzpix = HHorzpix
If IsMissing(NewVertpix) Then NewVertpix = Vvertpix
If IsMissing(NewBitsPerPel) Then NewBitsPerPel = BBitsPerPel
If HHorzpix = NewHorzpix And Vvertpix = NewVertpix And BBitsPerPel =
NewBitsPerPel Then Exit Function
'reduire la fenetre pour préparer chngt resolution
Application.WindowState = xlMinimized

'changer la résolution si accepté par la carte video
Do
If EnumDisplaySettingsA(vbNullString, i, DevMode) = 0 Then ChangeRes = -2:
Exit Function
i = i + 1
Loop Until DevMode.dmPelsWidth = NewHorzpix And DevMode.dmPelsHeight =
NewVertpix And DevMode.dmBitsPerpel = NewBitsPerPel

ChangeRes = ChangeDisplaySettingsA(DevMode, 0)
'ouvrir la fenetre au maxi
Application.WindowState = xlMaximized
'transmettre le résultat: réussi ou non
If ChangeRes = 1 Then ChangeRes = ChangeDisplaySettingsA(DevMode, 1)
If ChangeRes >= 0 Then ChangeRes = ChangeRes + 1
End Function

je me rends compte que DevMode ne semble pas renseigné... est-ce là le prob ?
c'est à
ChangeRes = ChangeDisplaySettingsA(DevMode, 0)
que ça se produit

bonjour André,

je crois que tu retrouvera les info. sur ce lien,

http://groups.google.com/group/microsoft.public.fr.excel/browse_thread/thread/b849ee5352248adb/b25916846324f828?lnk=st&q=&rnum=9&hl=fr#b25916846324f828

isabelle

bonjour à tous
il y a pas mal de temps on m'a donné, ici, les elements suivants pour
changer par VBA sur n'importe quelle machine, la résolution de l'écran... ça
marchait

j'ai du en perdre une partie parce que , sur w98, quand je passe de 850x600
à 1024 x768 la barre de taches se retrouve au milieu de l'écran.. et peut
être que ça crée d'autres désagréments... car excel se conduit assez
bizarrement, vba n'est pas stable... (mon logiciel comporte 4500 lignes... et
marchais bien jusqu'à maintenant)

voici mon code :

Option Explicit

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
dmdDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmForName As String * 32
dmUnusedPadding As Integer
dmBitsPerpel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDispayFlags 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
Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Function ChangeRes(Optional NewHorzpix, Optional NewVertpix,
Optional NewBitsPerPel) As Integer
Dim DevMode As TDEVMODE, i As Long
Dim HHorzpix As Integer, Vvertpix As Integer, BBitsPerPel As Integer
Dim DC As Long

' situation actuelle
DC = GetDC(0)
HHorzpix = GetDeviceCaps(DC, 8)
Vvertpix = GetDeviceCaps(DC, 10)
BBitsPerPel = GetDeviceCaps(DC, 12)
ReleaseDC 0, DC

If IsMissing(NewHorzpix) Then NewHorzpix = HHorzpix
If IsMissing(NewVertpix) Then NewVertpix = Vvertpix
If IsMissing(NewBitsPerPel) Then NewBitsPerPel = BBitsPerPel
If HHorzpix = NewHorzpix And Vvertpix = NewVertpix And BBitsPerPel =
NewBitsPerPel Then Exit Function
'reduire la fenetre pour préparer chngt resolution
Application.WindowState = xlMinimized

'changer la résolution si accepté par la carte video
Do
If EnumDisplaySettingsA(vbNullString, i, DevMode) = 0 Then ChangeRes = -2:
Exit Function
i = i + 1
Loop Until DevMode.dmPelsWidth = NewHorzpix And DevMode.dmPelsHeight =
NewVertpix And DevMode.dmBitsPerpel = NewBitsPerPel

ChangeRes = ChangeDisplaySettingsA(DevMode, 0)
'ouvrir la fenetre au maxi
Application.WindowState = xlMaximized
'transmettre le résultat: réussi ou non
If ChangeRes = 1 Then ChangeRes = ChangeDisplaySettingsA(DevMode, 1)
If ChangeRes >= 0 Then ChangeRes = ChangeRes + 1
End Function

je me rends compte que DevMode ne semble pas renseigné... est-ce là le prob ?
c'est à
ChangeRes = ChangeDisplaySettingsA(DevMode, 0)
que ça se produit