[RESOLU Merci]Problème lorsque je réduis mes Userforms qui sont en plein écran.

[perpitou]

Bonjour à tous,
J'ai un problème lorsque je réduis la fenêtre de mes userforms. En effet ils plantent et seuls les images servant de fond d'écran ( à l'userform) restent.
Il faut savoir:
- j'ai mis dans tous mes userforms le showmodal : false ( dans les propriétés)
- Ils sont tous en plein écran avec un code que j'ai trouvé sur une discussion du forum ( Je m'excuse auprès de son auteur de ne pas citer son nom) à savoir:

Dans le MODULE1:

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 Dans tous les userforms :

Private Sub UserForm_Activate()
Set user = Me: es
End Sub

Private Sub UserForm_Resize()
zz
End Sub

Merci d'avance!!

Bien cordialement,
perpitou

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Faut-il adapter la solution trouvé dans ce fil : https://www.excel-downloads.com/threads/comment-reduire-un-userform.29064/ ???

 

[Bebere]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

bonjour Perpitou

Public l(), h(), f(), p(), s() As String
rmq:la dernière variable est string les autres variant
tu incrémentes i avant de remplir,la 1ère ligne vide ou 0
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
i=i+1
Next

à bientôt

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

C'est bien pour la sub es() ??
En quoi cela cré mon problème? (Je cherche à comprendre )

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

J'ai essayé ça mélange tout dans mes userforms!

 

[Bebere]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

bonjour Perpitou
voilà un exemple
le code est dans module1
et pour comprendre employe la fenêtre variables locales et touche f8(exécute code pas à pas)
et touche F1 aide
à bientôt

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Merci Bebere de t'interresser à mon problème!

Donc ton code fonctionne mais c'est lorsque je répète plusieurs fois l'opération de réduire, rétablir en plein ecran plusieurs fois ça plante...

Je ne sais pas pourquoi!

Mais merci quand même

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Bonjour et bon début de semaine à tous,
je reviens avec mon problème car j'ai cherché partout une solution et je ne trouve pas!
Bien au contraire je ne vois pas d'erreur dans mon code. Mais le problème persiste !

Pourquoi? Si quelqu'un peut m'aider mercid d'avance!

 

[laetitia90]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

bonjour perpitou , Bebere
si tu pouvais mettre ton fichier sans données confi.... plus simple
a mon avis les images posent pb... a voir

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Bonjour laetitia90,
Merci pour ton aide! Je prépare ça et j'envoie.

Merci encore.

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Merci d'avance

 

[laetitia90]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

re,
essai d'enlever les images pour voir si meme pb..
si pb.. mettre les images dans des frames surtout sur ta page principale vu quel occupe pas toute la surface en enlevant les bordures du frame on remarque rien!!

apres si meme pb.. peut être un souci de variable public donc traiter individuellent chaque user
cela va entrainer de mettre le meme code dans chaque user
il faudrait que je me "penche" dessus mais la plus le temps

code pour chaque user en attendant je vais essayer de regarder en fin apres midi

P

rivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Dim l() As Long, h() As Long, f() As Long, p() As Long, s() As Long, wLong As Long, hWnd As Long, i, c As Control, la As Long, ha As Long
Private Sub UserForm_Activate()
 i = 0: ha = Me.Height: la = Me.Width
For Each c In Me.Controls
 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
  i = i + 1
 Next
hWnd = FindWindow(vbNullString, Me.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
Private Sub UserForm_Resize()
On Error Resume Next
i = 0
For Each c In Me.Controls
c.Width = Me.Width / (la / l(i))
c.Height = Me.Height / (ha / h(i))
c.Left = Me.Width / (la / f(i))
c.Top = Me.Height / (ha / p(i))
c.Font.Size = c.Width / s(i)
i = i + 1
Next
End Sub

commence par les images & ainsi de suite il faut proceder par élimination

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Ok Je regarde ça!! Merci beaucoup!

Je donne une réponse en fin de journée

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Bon déjà ce n'est pas les images... Le problème persiste.
ON va y arriver ... un jour

 

[perpitou]

Re : Problème lorsque je réduis mes Userforms qui sont en plein écran.

Bon Laeticia90, je te remercie pour ton aide. Je t'annonce une bonne et une mauvaise nouvelle ( sinon c'est trop facil ) :
-J'ai enlevé les images et réessayé mais j'avais les mêmes problèmes, lorsque je réduis puis agrandit et si je répète l'action plusieurs fois, le fichier planté.

-J'ai donc mis le code dans chaque userform (comme tu m'as conseillé), mon fichier ne plante plus MAIS maintenant quand je fais la même chose tous mes boutons et textbox se modifient lorsque je fais les mêmes choses!

Donc si tu as d'autres conseils je suis preneur car là... Je ne comprend pas!!
(PS : J'ai fait des imprims ecrans si ça tintéresse )
Merci d'avance!