RESOLUS plein ecran MERCI

[jmcr]

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

 

[Roland_M]

Bonjour,

voir exemple ici
https://www.excel-downloads.com/threads/resolus-plein-ecran-merci.20018683/#post-20136760

 

[jmcr]

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

 

[Roland_M]

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

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

 

[jmcr]

bonjour le forum ,Roland il bug fonctionne pas la première ligne

Public Sub UserformZoomEcran(Usf As Object)
merci quand même je continue ma recherche
amitié

 

[Roland_M]

Bonjour,

ceci fonctionne avec 2003 et plus ! (j'ai essayé avec 2003 et 2007 c'est ok !)

 

[jmcr]

merci Roland superbe réalisation chapeau bas il me reste plus qu'a l'étudier pour l adapté a mes besoins
mes sincères amitié
jmcr

 

[grisan29]

bonsoir Rolland_M, Jmcr et le Forum
Rolland_M très bien ton exemple que je me suis approprier