[VBA-E2003] Syntaxe pour changer la resolution de l ecran

Version imprimable

18/04/2006, 19h27
Slumpy

[VBA-E2003] Syntaxe pour changer la resolution de l ecran

Coucou, c'est enocre moi.

Voila, j'ai crée mon appli avec excel, mais j ai optimisé les fenetres pour une certaine resolution. Je voudrais donc modifier la resolution de l'ecran au depart de l'appli (et la remettre comme elle etait quand je quitte). Mais j avoue que je ne sais pas dutout comme faire.
Si quelqu un pouvait m'aider svp.

(Lol, j ai trouvé une Sub sur un autre forum en fait, mais elle me faisait crasher l'appli ^^)
18/04/2006, 20h04
jmfmarques

Regardes dans la FAQ de ce forum : tu y a un exemple très facile à trouver !;)
Tiens (20 secondes) :
http://vb.developpez.com/faq/?page=S...ger_resolution
et le suivant !

Ne perds cependant pas de vue un aspect essentiel : si tu développes sous une résolution qui n'est pas forcément prévue par la machine de l'utilisateur final, tu vas rencontrer de sérieux problèmes ! C'est la raison pour laquelle les plus prudents développent toujours dans une résolution (jamais très haute) disponible sur toutes les machines !:lol:
Car demander ta résolution à une machine qui n'a pas prévu une telle résolution te conduit bien évidemment à un beau "plantage" !
18/04/2006, 20h31
Slumpy

Ho le boulet ...

Je vais tester cette sub dessuite (en esperant qu'elle me crashe po mon appli :p)

Merci
18/04/2006, 21h01
Slumpy

Ho ho ! Zoom ? Ca doit etre mieux ca, car au moins je supose que ca fou pas le bordel sur le burreau, et evite des problemes.

Merci merci je vais voir ca :p
18/04/2006, 21h16
jmfmarques

Une question : Zoom, sous Excel, ce n'est pas que pour la feuille elle-même ?
Le zoom d'Excel "règle" aussi l'affichage des UserForms ?
19/04/2006, 15h27
Slumpy
Bo, j arrive a rien avec le zoom :(

Je vais retenir la solution de la resolution de l ecran. Mais si j ai bien compris la resolution désiré est defini ici :
Code:

1 2 Private Const DM_WIDTH = &H80000 Private Const DM_HEIGHT = &H100000
Ca c'est pour du 800*600, comment connait les valeurs pour d autres resolution svp ? (en loccurence se qui m interresse c 1280*960)

Merci ^^
19/04/2006, 15h37
jmfmarques

Ben non !

Ta résolution est à fixer par les 2 paramètres de la fonction appelée !
sgWidth As Long, sgHeight As Long

:lol:
PARDI !
19/04/2006, 19h40
ouskel'n'or

Tu peux éclairer ma lanterne ?

Merci
19/04/2006, 20h34
jmfmarques

La lanterne ?
Bonjour, voyou !
Elle est là, ma foi :
http://vb.developpez.com/faq/?page=S...ger_resolution
(lien auquel notre ami s'est référé)
Mais je reconnais que c'est mal expliqué (on n'y voit pas l'appel)
S'il faut un code de remplacement (à la jmf), je le donne (yakademandé):lol:
19/04/2006, 21h01
Slumpy

je sais pas si c clair pour vous, mais en tout cas, ca ne l est po pour moi

Voilà comment je procède avec le code de la FAQ :
Dans un module BAS sur lequel l'appli démarre, je mets ceci : (c'est du c/c, tu peux supprimer ce qui n'a pas trait à la résolution comme COLOR ou FREQ)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
Public X As Long
Public Y As Long
Public COLOR As Long
Public HAUT As Long
Public LARG As Long
Public FREQ As Long
 
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" _
(IpDevMode As Any, ByVal dwflags 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 Function GetDesktopWindow Lib "user32" () As Long
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Const ENUM_CURRENT_SETTINGS = &HFFFF - 1
Private Const WM_DEVMODECHANGE = &H1B
Private Const HWND_BROADCAST = &HFFFF&
Private Const HWND_DESKTOP = 0
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
Dim dmEcran As DEVMODE
Dim dmType As DEVMODE
Public Function CurrentDisplaySettings() As DEVMODE
    Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, CurrentDisplaySettings)
End Function
Public Sub ResolutionEcran(sgWidth As Long, sgHeight As Long, FrequenceRefresh As Long, QColor As Long)
    dmEcran.dmSize = LenB(dmEcran)
    Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, dmEcran)
    dmEcran.dmPelsWidth = sgWidth
    dmEcran.dmPelsHeight = sgHeight
    dmEcran.dmDisplayFrequency = FrequenceRefresh 'en Hz
    '4 : 16 colors
    '8 : 256 colors
    '16 : High Color
    '24 : True Color
    '32 : True Color
    dmEcran.dmBitsPerPel = QColor
    Call ChangeDisplaySettings(dmEcran, CDS_UPDATEREGISTRY)
    Call SendMessage(HWND_BROADCAST, WM_DEVMODECHANGE, 0, 0)
    Call SendMessage(GetDesktopWindow, WM_DEVMODECHANGE, 0, 0)
End Sub

Ensuite, dans le Form_load de la feuille appelée par le module BAS donc, la première Form de ton appli :

Code:

1
2
3
4
5
6
7
8
 
If X = 800 Then
        LARG = 1024
        HAUT = 768
        FREQ = 75
        COLOR = 32
        ResolutionEcran LARG, HAUT, FREQ, COLOR
End If

Ceci pour passer en 1024 si la résolution est 800x600 !

20/04/2006, 16h20
ouskel'n'or

Merci Khany.