Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel 800x600

800x600

9 réponses
Avatar
Hervé
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans le
Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela le met
en 800x600
Merci
Hervé
Signaler un problème avec ce contenu

9 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
Philippe.R
Bonsoir Hervé,
Je ne pense pas que via VBA, tu puisses modifier la résolution d'ecran du poste ; en revanche, tu peux
jouer sur le coefficient de zoom.
Pour rester dans ton exemple, le rapport entre les deux affichages est de 1,28.
Pour récupérer la résolution d'ecran, tu peux utiliser comme base :

' 32-bit API declaration
Declare Function GetSystemMetrics32 Lib "User32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

' 16-bit API declaration
Declare Function GetSystemMetrics16 Lib "user" _
Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer

Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1

Sub Test()
MsgBox RésolutionEcran
End Sub

Function RésolutionEcran() As String
'fs à partir de la Sub Video de luc-michel (mpfe)

If Left(Application.Version, 1) = 5 Then
'16-bit Excel
vidWidth = GetSystemMetrics16(SM_CXSCREEN)
vidHeight = GetSystemMetrics16(SM_CYSCREEN)
Else
'32-bit Excel
vidWidth = GetSystemMetrics32(SM_CXSCREEN)
vidHeight = GetSystemMetrics32(SM_CYSCREEN)
End If

RésolutionEcran = vidWidth & " x " & vidHeight
End Function

Sub Video()

If Left(Application.Version, 1) = 5 Then
'16-bit Excel
vidWidth = GetSystemMetrics16(SM_CXSCREEN)
vidHeight = GetSystemMetrics16(SM_CYSCREEN)
Else
'32-bit Excel
vidWidth = GetSystemMetrics32(SM_CXSCREEN)
vidHeight = GetSystemMetrics32(SM_CYSCREEN)
End If
ms = "The current video mode is: "
msd = vidWidth & " X " & vidHeight
Workbooks("phyopen.xls").Sheets("physika").Range("g73") = msd

If msd = "800 X 600" Then
ActiveWindow.Zoom = 100
Range("A1:J25").Select
Selection.RowHeight = 14.5
End If

End Sub


--
Amicales Salutations
XL 97 / 2000 / 2002
Préférez suivre facilement sur le forum :
news://msnews.microsoft.com/microsoft.public.fr.excel
(Voulez-vous vous abonner ? -> Oui)

"Hervé" a écrit dans le message de news:
ezrjfTo%
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans le Workbook_Close afin que
si un utilisateur a un écran en 1024x768 cela le met en 800x600
Merci
Hervé






Avatar
anomymousA
bonsoir,

ca c'est pas du ressort d'Excel mais de windows. Ceci dit en bricolant les
API ca doit peut-être pouvoir se faire. Va voir sur le site de Frédéric
Sigonneau. Peut-être y trouveras tu un début de réponse.

A+



Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans le
Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela le met
en 800x600
Merci
Hervé







Avatar
Michel Pierron
Bonsoir Hervé;
Je veux bien te donner la façon de faire, mais c'est tout à fait
déconseillé; pense à l'utilisateur qui va être très mécontent quand il devra
réorganiser son bureau, car le retour à la résolution d'origine ne résoud
pas ce problème.
MP

"Hervé" a écrit dans le message de
news:ezrjfTo%
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans
le

Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela le
met

en 800x600
Merci
Hervé






Avatar
Michel Pierron
Re Hervé;

Private Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName& _
, ByVal iModeNum&, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings& Lib "user32" _
Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags&)
Private Type DEVMODE
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 Sub ChangeResolution(W As Single, H As Single)
Dim OK As Boolean, i&, DVM As DEVMODE
Do
OK = EnumDisplaySettings(0&, i&, DVM)
i = i + 1
Loop Until OK = False
DVM.dmFields = &H80000 Or &H100000
DVM.dmPelsWidth = W
DVM.dmPelsHeight = H
ChangeDisplaySettings DVM, 0
End Sub

Sub Screen_800X600()
ChangeResolution 800, 600
End Sub

Sub Screen_1024X768()
ChangeResolution 1024, 768
End Sub

Si tu veux donner la liberté de laisser faire l'utilisateur, ce qui est
préférable à l'autoritarisme, tu peux utiliser:
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String _
, ByVal lpParameters As String, ByVal lpDirectory As String _
, ByVal nShowCmd As Long) As Long

Sub ScreenProperties()
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3"
End Sub

MP

"Hervé" a écrit dans le message de
news:ezrjfTo%
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans
le

Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela le
met

en 800x600
Merci
Hervé






Avatar
Hervé
Merci beaucoup Philippe
Je garde ta procédure très intéressante bien au chaud, car Michel m'a donné
la réponse.
Bonne journée
Hervé

"Philippe.R" a écrit dans le message de news:
OhC1Ino%
Bonsoir Hervé,
Je ne pense pas que via VBA, tu puisses modifier la résolution d'ecran du
poste ; en revanche, tu peux jouer sur le coefficient de zoom.
Pour rester dans ton exemple, le rapport entre les deux affichages est de
1,28.
Pour récupérer la résolution d'ecran, tu peux utiliser comme base :

' 32-bit API declaration
Declare Function GetSystemMetrics32 Lib "User32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

' 16-bit API declaration
Declare Function GetSystemMetrics16 Lib "user" _
Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer

Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1

Sub Test()
MsgBox RésolutionEcran
End Sub

Function RésolutionEcran() As String
'fs à partir de la Sub Video de luc-michel (mpfe)

If Left(Application.Version, 1) = 5 Then
'16-bit Excel
vidWidth = GetSystemMetrics16(SM_CXSCREEN)
vidHeight = GetSystemMetrics16(SM_CYSCREEN)
Else
'32-bit Excel
vidWidth = GetSystemMetrics32(SM_CXSCREEN)
vidHeight = GetSystemMetrics32(SM_CYSCREEN)
End If

RésolutionEcran = vidWidth & " x " & vidHeight
End Function

Sub Video()

If Left(Application.Version, 1) = 5 Then
'16-bit Excel
vidWidth = GetSystemMetrics16(SM_CXSCREEN)
vidHeight = GetSystemMetrics16(SM_CYSCREEN)
Else
'32-bit Excel
vidWidth = GetSystemMetrics32(SM_CXSCREEN)
vidHeight = GetSystemMetrics32(SM_CYSCREEN)
End If
ms = "The current video mode is: "
msd = vidWidth & " X " & vidHeight
Workbooks("phyopen.xls").Sheets("physika").Range("g73") = msd

If msd = "800 X 600" Then
ActiveWindow.Zoom = 100
Range("A1:J25").Select
Selection.RowHeight = 14.5
End If

End Sub


--
Amicales Salutations
XL 97 / 2000 / 2002
Préférez suivre facilement sur le forum :
news://msnews.microsoft.com/microsoft.public.fr.excel
(Voulez-vous vous abonner ? -> Oui)

"Hervé" a écrit dans le message de news:
ezrjfTo%
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans
le Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela
le met en 800x600
Merci
Hervé









Avatar
Hervé
Merci
Hervé

"anomymousA" a écrit dans le message
de news:
bonsoir,

ca c'est pas du ressort d'Excel mais de windows. Ceci dit en bricolant les
API ca doit peut-être pouvoir se faire. Va voir sur le site de Frédéric
Sigonneau. Peut-être y trouveras tu un début de réponse.

A+



Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans
le
Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela le
met
en 800x600
Merci
Hervé









Avatar
Hervé
Bonjour Michel
Merci beaucoup,
cela fonctionne très bien,
mais comment faire afin de lui signifier à la proc que si l'écran est déjà
en 800x600
ne pas utiliser celle-ci, en revanche si l'écran se trouve en 1024x768,
alors la mettre en 800x600, puis dans le workbook_BeforeClose la remettre en
1024x768
merci
Hervé


"Michel Pierron" a écrit dans le message de news:
eaTqN8o%
Re Hervé;

Private Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName& _
, ByVal iModeNum&, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings& Lib "user32" _
Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags&)
Private Type DEVMODE
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 Sub ChangeResolution(W As Single, H As Single)
Dim OK As Boolean, i&, DVM As DEVMODE
Do
OK = EnumDisplaySettings(0&, i&, DVM)
i = i + 1
Loop Until OK = False
DVM.dmFields = &H80000 Or &H100000
DVM.dmPelsWidth = W
DVM.dmPelsHeight = H
ChangeDisplaySettings DVM, 0
End Sub

Sub Screen_800X600()
ChangeResolution 800, 600
End Sub

Sub Screen_1024X768()
ChangeResolution 1024, 768
End Sub

Si tu veux donner la liberté de laisser faire l'utilisateur, ce qui est
préférable à l'autoritarisme, tu peux utiliser:
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String _
, ByVal lpParameters As String, ByVal lpDirectory As String _
, ByVal nShowCmd As Long) As Long

Sub ScreenProperties()
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3"
End Sub

MP

"Hervé" a écrit dans le message de
news:ezrjfTo%
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et dans
le

Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela le
met

en 800x600
Merci
Hervé









Avatar
Michel Pierron
Bonjour Hervé;
Dans le module ThisWorkbook:
Option Explicit
Private Declare Function GetSystemMetrics& _
Lib "user32" (ByVal nIndex&)
Private Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName& _
, ByVal iModeNum&, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings& Lib "user32" _
Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags&)
Private Type DEVMODE
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 R1024 As Boolean

Private Sub ChangeResolution(W As Single, H As Single)
Dim OK As Boolean, i&, DVM As DEVMODE
Do
OK = EnumDisplaySettings(0&, i&, DVM)
i = i + 1
Loop Until OK = False
DVM.dmFields = &H80000 Or &H100000
DVM.dmPelsWidth = W
DVM.dmPelsHeight = H
ChangeDisplaySettings DVM, 0
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If R1024 Then ChangeResolution 1024, 768
End Sub

Private Sub Workbook_Open()
R1024 = (GetSystemMetrics(0) = 1024)
If R1024 Then ChangeResolution 800, 600
End Sub

MP

"Hervé" a écrit dans le message de
news:e7Sqguu%
Bonjour Michel
Merci beaucoup,
cela fonctionne très bien,
mais comment faire afin de lui signifier à la proc que si l'écran est déjà
en 800x600
ne pas utiliser celle-ci, en revanche si l'écran se trouve en 1024x768,
alors la mettre en 800x600, puis dans le workbook_BeforeClose la remettre
en

1024x768
merci
Hervé


"Michel Pierron" a écrit dans le message de news:
eaTqN8o%
Re Hervé;

Private Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName& _
, ByVal iModeNum&, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings& Lib "user32" _
Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags&)
Private Type DEVMODE
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 Sub ChangeResolution(W As Single, H As Single)
Dim OK As Boolean, i&, DVM As DEVMODE
Do
OK = EnumDisplaySettings(0&, i&, DVM)
i = i + 1
Loop Until OK = False
DVM.dmFields = &H80000 Or &H100000
DVM.dmPelsWidth = W
DVM.dmPelsHeight = H
ChangeDisplaySettings DVM, 0
End Sub

Sub Screen_800X600()
ChangeResolution 800, 600
End Sub

Sub Screen_1024X768()
ChangeResolution 1024, 768
End Sub

Si tu veux donner la liberté de laisser faire l'utilisateur, ce qui est
préférable à l'autoritarisme, tu peux utiliser:
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String
_


, ByVal lpParameters As String, ByVal lpDirectory As String _
, ByVal nShowCmd As Long) As Long

Sub ScreenProperties()
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3"
End Sub

MP

"Hervé" a écrit dans le message de
news:ezrjfTo%
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et
dans



le
Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela
le



met
en 800x600
Merci
Hervé













Avatar
Hervé
Merci beaucoup Michel, cela fonctionne très bien, c'est très sympa de ta
part
dernier petite question,
comment se fait-il que les croix de fermeture disparaisse lorsque la
procédure est appliquée ?
Hervé



"Michel Pierron" a écrit dans le message de news:
eIlp88u%
Bonjour Hervé;
Dans le module ThisWorkbook:
Option Explicit
Private Declare Function GetSystemMetrics& _
Lib "user32" (ByVal nIndex&)
Private Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName& _
, ByVal iModeNum&, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings& Lib "user32" _
Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags&)
Private Type DEVMODE
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 R1024 As Boolean

Private Sub ChangeResolution(W As Single, H As Single)
Dim OK As Boolean, i&, DVM As DEVMODE
Do
OK = EnumDisplaySettings(0&, i&, DVM)
i = i + 1
Loop Until OK = False
DVM.dmFields = &H80000 Or &H100000
DVM.dmPelsWidth = W
DVM.dmPelsHeight = H
ChangeDisplaySettings DVM, 0
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If R1024 Then ChangeResolution 1024, 768
End Sub

Private Sub Workbook_Open()
R1024 = (GetSystemMetrics(0) = 1024)
If R1024 Then ChangeResolution 800, 600
End Sub

MP

"Hervé" a écrit dans le message de
news:e7Sqguu%
Bonjour Michel
Merci beaucoup,
cela fonctionne très bien,
mais comment faire afin de lui signifier à la proc que si l'écran est
déjà
en 800x600
ne pas utiliser celle-ci, en revanche si l'écran se trouve en 1024x768,
alors la mettre en 800x600, puis dans le workbook_BeforeClose la remettre
en

1024x768
merci
Hervé


"Michel Pierron" a écrit dans le message de
news:
eaTqN8o%
Re Hervé;

Private Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName& _
, ByVal iModeNum&, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings& Lib "user32" _
Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags&)
Private Type DEVMODE
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 Sub ChangeResolution(W As Single, H As Single)
Dim OK As Boolean, i&, DVM As DEVMODE
Do
OK = EnumDisplaySettings(0&, i&, DVM)
i = i + 1
Loop Until OK = False
DVM.dmFields = &H80000 Or &H100000
DVM.dmPelsWidth = W
DVM.dmPelsHeight = H
ChangeDisplaySettings DVM, 0
End Sub

Sub Screen_800X600()
ChangeResolution 800, 600
End Sub

Sub Screen_1024X768()
ChangeResolution 1024, 768
End Sub

Si tu veux donner la liberté de laisser faire l'utilisateur, ce qui est
préférable à l'autoritarisme, tu peux utiliser:
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As
String
_


, ByVal lpParameters As String, ByVal lpDirectory As String _
, ByVal nShowCmd As Long) As Long

Sub ScreenProperties()
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3"
End Sub

MP

"Hervé" a écrit dans le message de
news:ezrjfTo%
Bonjour
j'ai développé une appli qui tourne avec un écran 800 par 600
Je ne connais pas la procédure VBA à mettre dans le Workbook_Open et
dans



le
Workbook_Close afin que si un utilisateur a un écran en 1024x768 cela
le



met
en 800x600
Merci
Hervé