[VBA]Taille UserForm sous Excel
Résolu/Fermé
Neverend
Messages postés
21
Date d'inscription
vendredi 14 décembre 2007
Statut
Membre
Dernière intervention
29 octobre 2008
-
17 déc. 2007 à 15:25
gawanabana chico - 9 févr. 2010 à 22:24
gawanabana chico - 9 févr. 2010 à 22:24
A voir également:
- [VBA]Taille UserForm sous Excel
- Liste déroulante excel - Guide
- Comment réduire la taille d'un fichier - Guide
- Formule excel - Guide
- Si et excel - Guide
- Aller à la ligne excel - Guide
12 réponses
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 204
9 févr. 2010 à 19:00
9 févr. 2010 à 19:00
Bonjour,
Voilà à quoi ça peut ressembler en tenant compte du post #3 de Didier09 :
;o)
Voilà à quoi ça peut ressembler en tenant compte du post #3 de Didier09 :
Dim lar As Long, lng As Long
Private Sub UserForm_Initialize()
Dim ctl As Control
'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
If (Me.WindowState = 1) Then Exit Sub
For Each ctl In Me.Controls
If TypeOf ctl Is ComboBox Then
ctl.Move ctl.Left * Me.Width / lng, ctl.Top * Me.Height / lar, ctl.Width * Me.Width / lng
Else
If ExistProperty(ctl, "Width") And ExistProperty(ctl, "Height") Then
ctl.Move ctl.Left * Me.Width / lng, ctl.Top * Me.Height / lar, _
ctl.Width * Me.Width / lng, ctl.Height * Me.Height / lar
End If
End If
Next
lng = Me.Width
lar = Me.Height
End Sub
'Verifie si une propriété existe pour le controle.
Public Function ExistProperty(Obj As Object, ByVal PropertyName As String) As Boolean
On Error Resume Next
CallByName Obj, PropertyName, VbGet
ExistProperty = (Err.Number = 0)
Err.Clear
End Function
;o)
tout d'abord, merci pour cette réponse rapide
après essaie, je bloque sur l'initialisation de mon premier userform, qui ne se fai pas, le VBA plante et souvre avec une messagebox qui me dit: "erreur de compilation, membre de méthode ou de donné introuvable"
blocage a la ligne suivante, avec surlignage sur .windowState
If (Me.WindowState = 1) Then Exit Sub
j'ai copier votre code sur la page code de mon premier userform, j'ai pensé que c'était l'endroi approprier... mais je me trompe peu être, sinon mon erreur est ailleur et j'ai du mal a voir où...
si vous pouvez encore m'éclairé... merci d'avance
Gawa
après essaie, je bloque sur l'initialisation de mon premier userform, qui ne se fai pas, le VBA plante et souvre avec une messagebox qui me dit: "erreur de compilation, membre de méthode ou de donné introuvable"
blocage a la ligne suivante, avec surlignage sur .windowState
If (Me.WindowState = 1) Then Exit Sub
j'ai copier votre code sur la page code de mon premier userform, j'ai pensé que c'était l'endroi approprier... mais je me trompe peu être, sinon mon erreur est ailleur et j'ai du mal a voir où...
si vous pouvez encore m'éclairé... merci d'avance
Gawa
didier09
Messages postés
13
Date d'inscription
mercredi 28 février 2007
Statut
Membre
Dernière intervention
20 décembre 2007
36
20 déc. 2007 à 13:36
20 déc. 2007 à 13:36
Bonjour,
C'est tout à fait normal qu' une partie se retrouve en dehors de l'écran.
En effet, il faut repplacer tous ce qui se trouve sur l'UserForm, je l'avais oublié.
Dans l'initialisation du UserForm remplace tout par ceci.
Private Sub UserForm_Initialize()
'Déclaration des variables RX et RH
Dim RW As Single, RH As Single
'Calcule le rapport de l'UserForm et la taille de l'écran
RW = ScreenWidth * PointsPerPixel / Me.Width
RH = ScreenHeight * PointsPerPixel / Me.Height
'Met l'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
'Déclaration de la variable Ctl qui correspond aux contrôles de ton UserForm
Dim Ctl As MSForms.Control
'Permet de redimensionner tous tes contrôles présent sur l'UserForm en fonction de la taille de l'userForm et de la taille de l'écran
For Each Ctl In Me.Controls
Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH
Next
End Sub
J'espère que ça répondra à ton attente.
Didier
C'est tout à fait normal qu' une partie se retrouve en dehors de l'écran.
En effet, il faut repplacer tous ce qui se trouve sur l'UserForm, je l'avais oublié.
Dans l'initialisation du UserForm remplace tout par ceci.
Private Sub UserForm_Initialize()
'Déclaration des variables RX et RH
Dim RW As Single, RH As Single
'Calcule le rapport de l'UserForm et la taille de l'écran
RW = ScreenWidth * PointsPerPixel / Me.Width
RH = ScreenHeight * PointsPerPixel / Me.Height
'Met l'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
'Déclaration de la variable Ctl qui correspond aux contrôles de ton UserForm
Dim Ctl As MSForms.Control
'Permet de redimensionner tous tes contrôles présent sur l'UserForm en fonction de la taille de l'userForm et de la taille de l'écran
For Each Ctl In Me.Controls
Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH
Next
End Sub
J'espère que ça répondra à ton attente.
Didier
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 204
17 déc. 2007 à 15:35
17 déc. 2007 à 15:35
salut,
As-tu testé avec "screen" ?
;o)
Polux
As-tu testé avec "screen" ?
;o)
Polux
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Bonjour
Tout d'abord merci pour ce poste bien intérressant
avec mes petites connaissances excel, je suis arrivé à utiliser ce dernier code, et il fonction très bien pour la taille du userform, cepandant, j'ai à l'interieur de mes userforms, beaucoup de textbox ou commandbutton, et ceux-ci se chevauchent quand j'utilise mon fichier excel sur un PC qui possède un écran plus petit. Comment puis-je faire pour que chaque textbox, commandbutton, label... sois eux aussi proportionnelle à la taille de l'écran de l'ordi utilisé?
merci par avance a ceux qui pouront m'aider
Tout d'abord merci pour ce poste bien intérressant
avec mes petites connaissances excel, je suis arrivé à utiliser ce dernier code, et il fonction très bien pour la taille du userform, cepandant, j'ai à l'interieur de mes userforms, beaucoup de textbox ou commandbutton, et ceux-ci se chevauchent quand j'utilise mon fichier excel sur un PC qui possède un écran plus petit. Comment puis-je faire pour que chaque textbox, commandbutton, label... sois eux aussi proportionnelle à la taille de l'écran de l'ordi utilisé?
merci par avance a ceux qui pouront m'aider
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 204
9 févr. 2010 à 22:09
9 févr. 2010 à 22:09
bonsoir,
Exact, il faut supprimer cette ligne qui fonctionne en VB6 mais pas avec VBA.
Désolé
Bonne continuation
;o)
Exact, il faut supprimer cette ligne qui fonctionne en VB6 mais pas avec VBA.
Désolé
Bonne continuation
;o)
lol ne me dis pas désolé, tu m'hôte une bonne épine du pied...
effectivement sans cette ligne le code est passer complètement mais c'est de nouveau arrèté avec une message box qui cette fois me dit "division par zéro" et surligne ma ligne "UserForm.show" dans mon workbook.
J'ai pensé que ça pouvait être que involontairement j'aurai créé un boucle indéfini entre le workbook et mon userForm, enfin c'est peut etre une hypothèse stupide... j'ai l'impression qu'une fois ce blocage passer mon userform va se lancer... touhoujours hypothètique ... voir uthopique... lol
effectivement sans cette ligne le code est passer complètement mais c'est de nouveau arrèté avec une message box qui cette fois me dit "division par zéro" et surligne ma ligne "UserForm.show" dans mon workbook.
J'ai pensé que ça pouvait être que involontairement j'aurai créé un boucle indéfini entre le workbook et mon userForm, enfin c'est peut etre une hypothèse stupide... j'ai l'impression qu'une fois ce blocage passer mon userform va se lancer... touhoujours hypothètique ... voir uthopique... lol
Neverend
Messages postés
21
Date d'inscription
vendredi 14 décembre 2007
Statut
Membre
Dernière intervention
29 octobre 2008
81
17 déc. 2007 à 15:36
17 déc. 2007 à 15:36
Bonjour,
Oui, mais screen n'est pas reconnu sous VBA ...
Merci quand même
Oui, mais screen n'est pas reconnu sous VBA ...
Merci quand même
didier09
Messages postés
13
Date d'inscription
mercredi 28 février 2007
Statut
Membre
Dernière intervention
20 décembre 2007
36
17 déc. 2007 à 23:07
17 déc. 2007 à 23:07
Bonjour,
Dans un module place le code suivant
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0 'Screen width
Private Const SM_CYSCREEN = 1 'Screen height
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 Const LOGPIXELSX = 88 'Pixels/inch in X
'
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
'The width of the screen, in pixels
Public Function ScreenWidth() As Long
ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
End Function
'The height of the screen, in pixels
Public Function ScreenHeight() As Long
ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
End Function
'The size of a pixel, in points
Public Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
Ensuite Sur l'initialisation du formulaire
Private Sub UserForm_Initialize()
'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
End Sub
Je viens de le tester,chez moi ça marche.
Bonne programmation
Dans un module place le code suivant
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0 'Screen width
Private Const SM_CYSCREEN = 1 'Screen height
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 Const LOGPIXELSX = 88 'Pixels/inch in X
'
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
'The width of the screen, in pixels
Public Function ScreenWidth() As Long
ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
End Function
'The height of the screen, in pixels
Public Function ScreenHeight() As Long
ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
End Function
'The size of a pixel, in points
Public Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
Ensuite Sur l'initialisation du formulaire
Private Sub UserForm_Initialize()
'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
End Sub
Je viens de le tester,chez moi ça marche.
Bonne programmation
Bonjour,
Je me permet de vous interpeller car je suis débutant en Vba excel 2003 et j'ai repris votre source pour redimentionner l'écran, mais depuis la date systeme ne s'affiche plus dans un label et dans un textbox à l'ouverture de l' Userform, pourriez vous m'aider svp.
merci pour votre source.
fadan
Voici ma source:
Private Sub FRM_journalier_Initialize()
' votre source que j'ai repris et qui fonctionne très bien
Next
Dim madate As Date
madate = Format(Now(), "dddd dd mmmm yyyy") ' Déclaration du format de la dateSysteme
Lbl_dateSysteme = UCase(Left(madate, 1)) & Right(madate, Len(madate) - 1) ' Majuscule sur le nom du jour
Txt_dateDebut.Value = Format(Now(), "dd/mm/yyyy") ' Affichage de la date systeme dans le txt_dateDebut
Txt_heureDebut.Value = Format(Now(), "HH:mm") ' Affichage de l'heure systeme dans le textbox
End Sub
Je me permet de vous interpeller car je suis débutant en Vba excel 2003 et j'ai repris votre source pour redimentionner l'écran, mais depuis la date systeme ne s'affiche plus dans un label et dans un textbox à l'ouverture de l' Userform, pourriez vous m'aider svp.
merci pour votre source.
fadan
Voici ma source:
Private Sub FRM_journalier_Initialize()
' votre source que j'ai repris et qui fonctionne très bien
Next
Dim madate As Date
madate = Format(Now(), "dddd dd mmmm yyyy") ' Déclaration du format de la dateSysteme
Lbl_dateSysteme = UCase(Left(madate, 1)) & Right(madate, Len(madate) - 1) ' Majuscule sur le nom du jour
Txt_dateDebut.Value = Format(Now(), "dd/mm/yyyy") ' Affichage de la date systeme dans le txt_dateDebut
Txt_heureDebut.Value = Format(Now(), "HH:mm") ' Affichage de l'heure systeme dans le textbox
End Sub
Neverend
Messages postés
21
Date d'inscription
vendredi 14 décembre 2007
Statut
Membre
Dernière intervention
29 octobre 2008
81
17 déc. 2007 à 23:26
17 déc. 2007 à 23:26
Bonsoir,
Merci beaucoup, je teste ça demain et je te tiens au courant.
Si ça marche tu m'enlèves une grosse épine ...
Merci beaucoup, je teste ça demain et je te tiens au courant.
Si ça marche tu m'enlèves une grosse épine ...
Neverend
Messages postés
21
Date d'inscription
vendredi 14 décembre 2007
Statut
Membre
Dernière intervention
29 octobre 2008
81
19 déc. 2007 à 11:01
19 déc. 2007 à 11:01
Bonjour,
Merci Didier pour ton aide, ça marche en partie ... sur des pc portables avec des écrans 14", ça ne fonctionne pas, j'ai toujours une partie de mon formulaire en dehors de l'écran ...
Ce qui fait que mon fichier n'est pas portable (lol) ...
Merci encore pour ta contribution.
Merci Didier pour ton aide, ça marche en partie ... sur des pc portables avec des écrans 14", ça ne fonctionne pas, j'ai toujours une partie de mon formulaire en dehors de l'écran ...
Ce qui fait que mon fichier n'est pas portable (lol) ...
Merci encore pour ta contribution.
Neverend
Messages postés
21
Date d'inscription
vendredi 14 décembre 2007
Statut
Membre
Dernière intervention
29 octobre 2008
81
20 déc. 2007 à 16:16
20 déc. 2007 à 16:16
bonjour Didier,
J'avais intégré le redimensionnement des controles dans l'UserForm ... le problème ne vient pas de là ... Je pense que cela vient du fait que j'ai fait cette petite appli sur Excel 2007, même en sauvegardant a un format antérieur. J'ai repris le fichier sur un autre ordi avec Excel 2003, et cette fois l'appli passe sans problème partout ... merci Microsoft pour les compatibilités ... Autre inconvénient, lors des tests en mode débogeur, si il y a une correction à faire. Il faut fermer Excel, le relancer, faire les modifs et sauvegarder ... je me suis aperçu que si l'on ne fait pas comme ça et que l'on arrête le débogeur avant la fin de l'excécution, les modifs ne sont pas prises en compte. Excel considère qu'il y a eu un plantage et restore la dernière version lors du lancement de l'appli ... c'est assez prise de tête ...
Merci encore pour ton aide.
Neverend
J'avais intégré le redimensionnement des controles dans l'UserForm ... le problème ne vient pas de là ... Je pense que cela vient du fait que j'ai fait cette petite appli sur Excel 2007, même en sauvegardant a un format antérieur. J'ai repris le fichier sur un autre ordi avec Excel 2003, et cette fois l'appli passe sans problème partout ... merci Microsoft pour les compatibilités ... Autre inconvénient, lors des tests en mode débogeur, si il y a une correction à faire. Il faut fermer Excel, le relancer, faire les modifs et sauvegarder ... je me suis aperçu que si l'on ne fait pas comme ça et que l'on arrête le débogeur avant la fin de l'excécution, les modifs ne sont pas prises en compte. Excel considère qu'il y a eu un plantage et restore la dernière version lors du lancement de l'appli ... c'est assez prise de tête ...
Merci encore pour ton aide.
Neverend
