Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

RESOLUS plein ecran MERCI

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion jmcr
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

jmcr

XLDnaute Occasionnel
bonsoir le forum
j ai une petite demande mon dossier fonctionne très bien grâce aux amis (es) qui sont sur le forum
j ai recherché sur internet comment mettre mon useforme en plein écran seulement j ai trouvé jusqu'à présent un plein écran avec disparitions de mes barres se que je veux surtout pas car j ai plus de barre et grosse galère pour les remettre en place si je veux ouvrir un autre dossier comment avoir un plein écrans sans faire totalement faire disparaître ses barres
merci pour tout renseignement
amitié sincére
JMCR
 
Trier par date Trier par votes
merci beaucoup roland
mais je suis désoler j ai un bug ici en bleu

Public Sub UserformZoomEcran(Usf As Object)
Dim RW@, RH@, PtToPx#, PosTop@, FMaxUserfWidth@, FMaxUserfHeight@
'PtToPx = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager\LastLoadedDPI") / 72
PtToPx = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / (ActiveWindow.Zoom / 100)
PosTop = ActiveWindow.ActivePane.PointsToScreenPixelsY(Cells(1, 1).Top) / PtToPx
FMaxUserfWidth = Application.Width - 12
FMaxUserfHeight = Application.Height + 18 - 30 - PosTop '30=HautBarreTache
With Usf
.StartUpPosition = 0: .Top = 0: .Left = 0 'position 0
RW = .Width / .Zoom: RH = .Height / .Zoom 'agrandi au max
While .Width < FMaxUserfWidth And .Height < FMaxUserfHeight And .Zoom < 400
.Zoom = .Zoom + 1: .Width = .Zoom * RW: .Height = .Zoom * RH
Wend
RW = .Width / .Zoom: RH = .Height / .Zoom 'diminue si trop grand
While (.Width > FMaxUserfWidth Or .Height > FMaxUserfHeight) And .Zoom > 10
.Zoom = .Zoom - 1: .Width = .Zoom * RW: .Height = .Zoom * RH
Wend
End With
With Usf: .Top = PosTop: .Left = (FMaxUserfWidth - .Width) * 0.5: End With 'centre
End Sub
 
Vote positif 0 Vote négatif
Bonsoir,

effectivement tu as Excel 2003 et ActivePane n'est pas compatible !?
je vais voir si je peux contourner cela mais je ne te promet rien !?

essaies de remplacer ce sub avec ce nouveau code

Code: 
Public Sub UserformZoomEcran(Usf As Object)
Dim RW@, RH@, PtToPx#, PosTop@, FMaxUserfWidth@, FMaxUserfHeight@
'avec Excel supp 2003 (à cause de ActivePane)
'PtToPx = ((ActiveWindow.ActivePane.PointsToScreenPixelsX(ActiveSheet.[A1].Width) - ActiveWindow.ActivePane.PointsToScreenPixelsX(0)) / ActiveSheet.[A1].Width) / (ActiveWindow.Zoom / 100)
'PosTop = ActiveWindow.ActivePane.PointsToScreenPixelsY(Cells(1, 1).Top) / PtToPx
'avec excel 2003
PtToPx = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager\LastLoadedDPI") / 72
PosTop = ActiveWindow.PointsToScreenPixelsY(Cells(1, 1).Top) / PtToPx
FMaxUserfWidth = Application.Width - 12
FMaxUserfHeight = Application.Height + 18 - 30 - PosTop '30=HautBarreTache
With Usf
.StartUpPosition = 0: .Top = 0: .Left = 0 'position 0
RW = .Width / .Zoom: RH = .Height / .Zoom 'agrandi au max
While .Width < FMaxUserfWidth And .Height < FMaxUserfHeight And .Zoom < 400
   .Zoom = .Zoom + 1: .Width = .Zoom * RW: .Height = .Zoom * RH
Wend
RW = .Width / .Zoom: RH = .Height / .Zoom 'diminue si trop grand
While (.Width > FMaxUserfWidth Or .Height > FMaxUserfHeight) And .Zoom > 10
   .Zoom = .Zoom - 1: .Width = .Zoom * RW: .Height = .Zoom * RH
Wend
End With
With Usf: .Top = PosTop: .Left = (FMaxUserfWidth - .Width) * 0.5: End With 'centre
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
[REF] Wiki Page 7 de MichelXld
Réponses
0
Affichages
51 K
MichelXld
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…