Recuperer la resolution d'ecran

Version imprimable

21/09/2010, 12h30
Chipss

Recuperer la resolution d'ecran

Je cherche à récuperer la resolution de l'ecran sur lequel tourne le programme que je suis en train de concevoir.

Je pensait utilisé les propriuétés .Width et .Height associé à l'objet Screen comme en VB, mais à la compilation VBA me repond "Objet requis".

Si quelqu'un savait commenet faire cela m'aiderai...

Chipss

Bonjour Chipss,

à tester

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Dim HP As Long, VP As Long, BPP 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 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
Sub AfficheRes()
    LireRes HP, VP, BPP
    MsgBox HP & "x" & VP & " couleurs " & BPP & " bits"
End Sub

Lance AfficheRes pour voir les résultats

salut tototiti2008

Evite de passer par Amsterdam, si tu veux te rendre à Alger.

tout simplement :

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
 
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 Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
 
Private Sub Commandbutton1_Click()
   Dim DevM As DEVMODE
   Call EnumDisplaySettings(0&, -1&, DevM)
   MsgBox "ton écran a une rtésolution de " & DevM.dmPelsWidth & " pixels" & " par " & DevM.dmPelsHeight & " pixels"
End Sub

21/09/2010, 13h47
EvaristeGaloisBis

Citation:

Evite de passer par Amsterdam, si tu veux te rendre à Alger.

Et si on part de scandinavie, n'est pas ce le chemin le plus court? °_°
21/09/2010, 13h59
Chipss

Lol tres bon la repartie EvaristeGaloisBis :)

Bref la solution de babothe semble marcher :) Un leger probleme au niveau de la barre demarrer mais je vais m'en occuper.

J'aurais eventuellement une deuxieme question:
Est ce que vous savez quelle propriété est utiliser pour placer une fenetre à l'endroit souhaité, par exemple dans le coin gauche?

Merci en tout cas pour cette premiere reponse :)

Chipss
21/09/2010, 14h00
EvaristeGaloisBis

a tout hasard la propriété Left? et Top? Non?

Oui c'est ca merci ;)

Ci dessous le code pour mettre 2 fenetre Ie cote à cote pour les comparer,si ca interesse quelqu'un...

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
 
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 Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
 
Private Sub Commandbutton1_Click()
   Dim DevM As DEVMODE
   Call EnumDisplaySettings(0&, -1&, DevM)
   'MsgBox "ton écran a une rtésolution de " & DevM.dmPelsWidth & " pixels" & " par " & DevM.dmPelsHeight & " pixels"
 
Dim ie, ie2 As Variant
Dim url As String
 
url = "https://shared-workspaces.corp.intraxa/GroupSolutions/Support/Propale/Lists/Testfact/NewForm.aspx?RootFolder=%2FGroupSolutions%2FSupport%2FPropale%2FLists%2FTestfact&Source=https%3A%2F%2Fshared%2Dworkspaces%2Ecorp%2Eintraxa%2FGroupSolutions%2FSupport%2FPropale%2FLists%2FTestfact%2FAllItems%2Easpx"
url2 = "C:\Documents and Settings\f-freyssinier\Desktop\DO243615.html"
Set ie = CreateObject("InternetExplorer.Application")
 
ie.Navigate url
ie.Width = DevM.dmPelsWidth / 2
ie.Height = DevM.dmPelsHeight
ie.left = DevM.dmPelsWidth / 2
ie.tOp = 0
ie.Visible = True
 
Set ie2 = CreateObject("InternetExplorer.Application")
ie2.Navigate url2
ie2.Width = DevM.dmPelsWidth / 2
ie2.Height = DevM.dmPelsHeight
 
ie2.left = 0
ie2.tOp = 0
 
ie2.Visible = True
 
'ShellExecute 0&, vbNullString, myOrt & MesAttachments(j).DisplayName, vbNullString, vbNullString, vbNormalFocus
 
End Sub

Merci bcp à vous deux pour vos reponse...je pensais pas réussir aussi rapidement ;)

Chipss

J'ai un vol direct pour Alger...:mouarf:

Code:

1
2
3
4
5
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
 
Sub AfficherResolution()
MsgBox "La résolution de votre écran est de " & GetSystemMetrics(0) & " x " & GetSystemMetrics(1)
End Sub

21/09/2010, 15h23
Chipss

Ah encore mieux :) Ca m'evite d'avoir a definir un type ;)

Merci à vous 3!