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 75 76 77 78 79 80 81 82 83 84 85
| Private Declare PtrSafe Function GetSystemMetrics& _
Lib "USER32" (ByVal nIndex&)
Private Declare PtrSafe Function GetForegroundWindow& _
Lib "USER32" ()
Private Declare PtrSafe Function GetWindowRect& _
Lib "USER32" (ByVal hWnd&, lpRect As RECT)
Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As Long
'fonction pour mettre le curseur à un endroit voulu
Declare Function SetCursorPos Lib "USER32" ( _
ByVal X As Long, _
ByVal Y As Long) As Long
' ---API permettant de déplacer la souris---
Declare Sub mouse_event Lib "USER32" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
' ---Définition des constantes---
Global Const MOUSEEVENTF_ABSOLUTE = &H8000
Global Const MOUSEEVENTF_LEFTDOWN = &H2
Global Const MOUSEEVENTF_LEFTUP = &H4
Global Const MOUSEEVENTF_MIDDLEDO = &H20
Global Const MOUSEEVENTF_MIDDLEUP = &H40
Global Const MOUSEEVENTF_MOVE = &H1
Global Const MOUSEEVENTF_RIGHTDOW = &H8
Global Const MOUSEEVENTF_RIGHTUP = &H10
'---Constantes Mot de Passe---
Public Const pwIndicateurs As String = "PW1"
Public Const pwDonnees As String = "PW2"
Public Const pwParametres As String = "PW3"
Public Const pwParametrage_Dotation As String = "PW4"
Public Const pwPlan_D_Action As String = "PW5"
Public Const pwWorkbook As String = "PW6"
Public Const pwVba As String = "PW7"
Public Const pwDonneesGraph As String = "PW8"
Public Const pwSecurite As String = "PW9"
Private Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
Public Function GetScreenResolution() As String
Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long
hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
End Function
Sub Resolution()
Dim Info As String, hWnd As Long, R As RECT
Info = "Résolution écran:" & vbTab _
& GetSystemMetrics(0) & " x " _
& GetSystemMetrics(1) & vbLf
hWnd = GetForegroundWindow
GetWindowRect hWnd, R
'Info = Info & "Fenêtre active:" & vbTab _
'& (R.Right - R.Left) & " x " & R.Bottom - R.Top
Info = Info & vbLf & "Fenêtre Excel:" & vbTab _
& Application.Width * 4 / 3 & " x " & Application.Height * 4 / 3
MsgBox Info
End Sub
Public Sub AutoAjust()
Dim LargeurEcran As Long
Dim HauteurEcran As Long
LargeurEcran = GetSystemMetrics(0)
HauteurEcran = GetSystemMetrics(1)
If HauteurEcran < 850 Then
form_Saisie.Height = 480
form_Saisie.Width = 622
form_Saisie.Zoom = 90
form_Saisie.Left = 40
form_Saisie.Top = 50
End If
End Sub |
Partager