Discussion :

[Chipss]

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

[tototiti2008]

Bonjour Chipss,

à tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[babaothe]

salut tototiti2008

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

tout simplement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[EvaristeGaloisBis]

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? °_°

[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

[EvaristeGaloisBis]

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

[Chipss]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[fring]

J'ai un vol direct pour Alger...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Chipss]

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

Merci à vous 3!