Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel USF plein ecran, formule excelabo ??

USF plein ecran, formule excelabo ??

10 réponses
Avatar
Chokes
Bonjour toutes et tous

je tente depuis ce mati, de faire fonctionner la formule trouvée sur
l'excellent site Excelabo mais là je n'y arrive pas. QQ un peux t'il me dire
où je pêche.

Ci-dessous la copie intégrale de la question initiale et la réponse :

Je recherche le moyen d'afficher un UserForm en plein écran quelque soit la
résolution d'affichage de Windows, que les objets qu'il contient soient
redimensionnés en conséquence, que l'on ne puisse pas déplacer cette fenêtre
et que l'on ne puisse pas la fermer avec la croix.
Dans le module de ton UserForm, place en tête de ton module les déclarations
suivantes:

Private Declare Function FindWindowA Lib "User32" (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 SetWindowLongA Lib "User32" (ByVal hWnd As Long,
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Ensuite la procédure évènementielle (n'oublie sutout pas d'inclure un bouton
pour fermer l'UserForm car dans ce cas, tu n'auras même plus la barre de
titre de l'UserForm !) :

Private Sub UserForm_Initialize()
Dim hWnd As Long, exLong As Long, zFactor As Integer

hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If exLong And &H880000 Then SetWindowLongA hWnd, -16, exLong And &HFF77FFFF
zFactor = 100 * CInt(Application.Width / Me.Width)
If zFactor > 400 Then zFactor = 400
MsgBox zFactor
Me.Width = Application.Width
Me.Height = Application.Height
Me.Zoom = zFactor
End Sub

Merci pour vos réponses
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
LSteph
Bonjour "Chokes",
ici:
http://cjoint.com/?bCqcTEEJeL

'*****
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 UserForm_Initialize()
Dim DC As Long
DC = GetDC(0)
Me.Width = 20 + (GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72)
Me.Height = GetDeviceCaps(DC, 10) / GetDeviceCaps(DC, 90) * 72
ReleaseDC 0, DC


End Sub
'***
'lSteph
"Chokes" a écrit dans le message de news:

Bonjour toutes et tous

je tente depuis ce mati, de faire fonctionner la formule trouvée sur
l'excellent site Excelabo mais là je n'y arrive pas. QQ un peux t'il me
dire
où je pêche.

Ci-dessous la copie intégrale de la question initiale et la réponse :

Je recherche le moyen d'afficher un UserForm en plein écran quelque soit
la
résolution d'affichage de Windows, que les objets qu'il contient soient
redimensionnés en conséquence, que l'on ne puisse pas déplacer cette
fenêtre
et que l'on ne puisse pas la fermer avec la croix.
Dans le module de ton UserForm, place en tête de ton module les
déclarations
suivantes:

Private Declare Function FindWindowA Lib "User32" (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 SetWindowLongA Lib "User32" (ByVal hWnd As Long,
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Ensuite la procédure évènementielle (n'oublie sutout pas d'inclure un
bouton
pour fermer l'UserForm car dans ce cas, tu n'auras même plus la barre de
titre de l'UserForm !) :

Private Sub UserForm_Initialize()
Dim hWnd As Long, exLong As Long, zFactor As Integer

hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If exLong And &H880000 Then SetWindowLongA hWnd, -16, exLong And
&HFF77FFFF
zFactor = 100 * CInt(Application.Width / Me.Width)
If zFactor > 400 Then zFactor = 400
MsgBox zFactor
Me.Width = Application.Width
Me.Height = Application.Height
Me.Zoom = zFactor
End Sub

Merci pour vos réponses


Avatar
Chokes
Merci LSteph,

Si je puis me permettre, ta réponse fonctionne bien mais incomplète en ce
sens où la fenetre est légèrement trop grande par rapport à l'ecran et sur
Excelabo j'appréciais la possibilité de tout redimensionner ni déplacer la
fenetre, or là ce n'est pas encore le cas.

Y a t'il un complément à faire ?

merci à toi
Avatar
LSteph
A l'origine du code qui me sert et dont je l'extrais c'est le but (mai
c'est accessible quand même)!
c'est que le uf est derrière msgbox et que celui-ci se referme tout de suite
après.
Donc modifier le code pour cela ici:
Private Sub Workbook_Open()
UFsteph.Show
MsgBox " J'aime VBA, Excel et le MPFE " 'tu peux enlever si tuveux
UFsteph.Hide 'tu dois l'enlever sinon il se referme
end sub

et puis ceci dans le code de l'UF:
Me.Width = 20 + (GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72)
'enlever le '20+( ' ....puis enlever
aussi.........................................................')'
Me.Width = GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72


a+

lSteph

"Chokes" a écrit dans le message de news:

Merci LSteph,

Si je puis me permettre, ta réponse fonctionne bien mais incomplète en ce
sens où la fenetre est légèrement trop grande par rapport à l'ecran et sur
Excelabo j'appréciais la possibilité de tout redimensionner ni déplacer la
fenetre, or là ce n'est pas encore le cas.

Y a t'il un complément à faire ?

merci à toi


Avatar
Chokes
Re,

J'ai bien supprimer le "20" et la fenetre occupe bien 100% de l'ecran.

par contre pour l'instant cela ne redimensionne pas les boutons à
l'interieur de la fenetre qui restent sur le coté haut à gauche au lieu de se
retrouver bien au milieu comme à l'origine du USF.

je dois louper une marche
Avatar
LSteph
...ma proposition concernait juste l'affichage d'un userform en mode plein
écran de windows
indépendament de la dimension de la fenêtre d'excel. Je ne pensais pas avoir
à replacer une position
(selon moi) prédéfinie par rapport à top ou left des controls présents dans
le UF.
Désolé...c'est moi qui ai dû rater une marche ...

a+

lSteph



"Chokes" a écrit dans le message de news:


Re,

J'ai bien supprimer le "20" et la fenetre occupe bien 100% de l'ecran.

par contre pour l'instant cela ne redimensionne pas les boutons à
l'interieur de la fenetre qui restent sur le coté haut à gauche au lieu de
se
retrouver bien au milieu comme à l'origine du USF.

je dois louper une marche


Avatar
Chokes
LSteph,

C'est déjà extremement sympa de m'avoir super bien repondu pour l'ecran et
je t'en remercie bcp
Avatar
LSteph
;o) merci de ta gratitude et de ton indulgence, j'espère que quelqu'un de
plus avisé viendra complèter.

lSteph


"Chokes" a écrit dans le message de news:

LSteph,

C'est déjà extremement sympa de m'avoir super bien repondu pour l'ecran et
je t'en remercie bcp


Avatar
docm
Bonour.

Pour compléter et redimensionner les controles du Userform :


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

Dim myWidth As Integer
Dim myHeight As Integer


Private Sub UserForm_Initialize()
Dim DC As Long
myWidth = Me.Width
myHeight = Me.Height
DC = GetDC(0)
Me.Width = (GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72)
Me.Height = GetDeviceCaps(DC, 10) / GetDeviceCaps(DC, 90) * 72
ReleaseDC 0, DC


End Sub


Private Sub UserForm_Resize()
Dim ctl As Control

If myWidth <> 0 Then

For Each ctl In Me.Controls

ctl.Left = ctl.Left * Me.Width / myWidth
ctl.Top = ctl.Top * Me.Height / myHeight
ctl.Height = ctl.Height * Me.Height / myHeight
ctl.Width = ctl.Width * Me.Width / myWidth

Next


myWidth = Me.Width
myHeight = Me.Height

End If

End Sub


"Chokes" a écrit dans le message de news:

Re,

J'ai bien supprimer le "20" et la fenetre occupe bien 100% de l'ecran.

par contre pour l'instant cela ne redimensionne pas les boutons à
l'interieur de la fenetre qui restent sur le coté haut à gauche au lieu de se
retrouver bien au milieu comme à l'origine du USF.

je dois louper une marche


Avatar
Benead
Bonsoir Choques,

Essaie comme ceci :

Private Sub UserForm_Initialize()
Dim DC As Long
DC = GetDC(0)
Me.Zoom = Me.Zoom * (GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72) / Me.Width
Me.Width = (GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72)
Me.Height = GetDeviceCaps(DC, 10) / GetDeviceCaps(DC, 90) * 72
ReleaseDC 0, DC
End Sub


Le zoom redimmensionne les objets de l'UserForm. Pour plus d'infos, va voir l'aide en ligne.

A+
Benead

LSteph a écrit:
;o) merci de ta gratitude et de ton indulgence, j'espère que quelqu'un de
plus avisé viendra complèter.

lSteph


"Chokes" a écrit dans le message de news:


LSteph,

C'est déjà extremement sympa de m'avoir super bien repondu pour l'ecran et
je t'en remercie bcp







Avatar
Benead
Bonsoir Chokes,

Essaie comme ceci :

Private Sub UserForm_Initialize()
Dim DC As Long
DC = GetDC(0)
Me.Zoom = Me.Zoom * (GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72) / Me.Width
Me.Width = (GetDeviceCaps(DC, 8) / GetDeviceCaps(DC, 88) * 72)
Me.Height = GetDeviceCaps(DC, 10) / GetDeviceCaps(DC, 90) * 72
ReleaseDC 0, DC
End Sub


Le zoom redimmensionne les objets de l'UserForm. Pour plus d'infos, va voir l'aide en ligne.

A+
Benead

Chokes a écrit:
LSteph,

C'est déjà extremement sympa de m'avoir super bien repondu pour l'ecran et
je t'en remercie bcp