Bonsoir,
J'ai dans mon classeur excel un Userform que je voudrais afficher en plein écran et qui s'adapte à la résolution d'écran (pas de souci ca fonctionne).
Le souci se situe toujours dans la même problématique mais avec un Userform qui contient un multipage, qui lui même contient des images en .gif
Excel bug, et me renvoie un message d'erreur:
Voici le code que j'utilise:
Placer dans un module:
et placer dans l'userform:
le code se met en erreur sur la ligne: ReDim Preserve s(i): s(i) = c.Width / c.Font.Size
Comment puis faire pour que cela fonctionne.
J'ai dans mon classeur excel un Userform que je voudrais afficher en plein écran et qui s'adapte à la résolution d'écran (pas de souci ca fonctionne).
Le souci se situe toujours dans la même problématique mais avec un Userform qui contient un multipage, qui lui même contient des images en .gif
Excel bug, et me renvoie un message d'erreur:
Voici le code que j'utilise:
Placer dans un module:
Code:
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Const GWL_STYLE = (-16), GWL_EXSTYLE = (-20), WS_SIZEBOX = &H40000, WS_TROIS_BOUTON = &H70000, WS_EX_APPWINDOW = &H40000
Public l(), h(), f(), p(), s() As String, wLong As Long, hWnd As Long, i, c As Control, la As Long, ha As Long
Public user As Object
Sub es()
i = 0: ha = user.Height: la = user.Width
For Each c In user.Controls
i = i + 1
ReDim Preserve l(i): l(i) = c.Width
ReDim Preserve h(i): h(i) = c.Height
ReDim Preserve p(i): p(i) = c.Top
ReDim Preserve f(i): f(i) = c.Left
ReDim Preserve s(i): s(i) = c.Width / c.Font.Size
Next
hWnd = FindWindow(vbNullString, user.Caption)
wLong = GetWindowLongA(hWnd, GWL_STYLE) Or WS_SIZEBOX Or WS_TROIS_BOUTON
SetWindowLong hWnd, GWL_STYLE, wLong
ShowWindow hWnd, 3 'plein ecran a ouverture
End Sub
Sub zz()
On Error Resume Next
i = 0
For Each c In user.Controls
i = i + 1
c.Width = user.Width / (la / l(i))
c.Height = user.Height / (ha / h(i))
c.Left = user.Width / (la / f(i))
c.Top = user.Height / (ha / p(i))
c.Font.Size = c.Width / s(i)
Next
End Sub
et placer dans l'userform:
Code:
Private Sub UserForm_Activate()
Set user = Me: es
End Sub
Private Sub UserForm_Resize()
zz
End Sub
le code se met en erreur sur la ligne: ReDim Preserve s(i): s(i) = c.Width / c.Font.Size
Comment puis faire pour que cela fonctionne.