RESOLU par ROLAND UserForm affichage selon taille écran (pas plein écran)

'1/3) PLACER CE CODE DANS UN MODULE
'(je n'utilise pas d'API pour garder une compatibilité maximum)
'------------------------------------
'2/3) PLACER CECI DANS VOTRE USERFORM
'choix "centre" "haut"ou"<haut>" "<haut" "haut>" "bas"ou"<bas>" "<bas" "bas>"
'Private Sub UserForm_Activate()
' UserformZoomSelonResolution Me, "" 
'End Sub
'-----------------------------------
'3/3) METTRE LA RESOLUTION dans laquelle a été réalisé l'userf dans les 2 constantes ci-dessous

Public Const ResolutionCreatX% = 1024, ResolutionCreatY% = 768
'REM: perso je place la résolution dans les propriétés
'Me.ScrollWidth Me.ScrollHeight, c'est prévu ci-dessous


'NE RIEN MODIFIER CI-DESSOUS SI PAS COMPETENT
Public Sub UserformZoomSelonResolution(fmME As Object, PosFmME$)
Dim RxActuel%, RyActuel%, RxDeBase%, RyDeBase%, RX@, RY@, LimitB%
RxActuel = FResolutionXwinPixel: RyActuel = FResolutionYwinPixel
RxDeBase = fmME.ScrollWidth: RyDeBase = fmME.ScrollHeight
If RxDeBase = 0 Or RyDeBase = 0 Then RxDeBase = ResolutionCreatX: RyDeBase = ResolutionCreatY
If RxDeBase = 0 Or RyDeBase = 0 Then MsgBox "La résolution de base n'est pas définie !?", vbCritical, "erreur": Exit Sub
RX = RxActuel / RxDeBase: RY = RyActuel / RyDeBase
If RX < 1 Then RX = RX + ((1 - RX) * 0.2) Else RX = 1 + ((RX - 1) * 0.2) 'réglage pour limiter l'agrandissement
If RY < 1 Then RY = RY + ((1 - RY) * 0.2) Else RY = 1 + ((RY - 1) * 0.2) '0.5 =50% ce qui est > à 100 exp 1,50 fera 1,25
If RX > 4 Then RX = 4 '400maxi avec zoom
'redim userf sans StartUpPosition avec Zoom
Dim RW@, RH@, SvgZoom%, W%, H%
With fmME
 If RX > 4 Then RX = 4 '400 maxi
 .Zoom = 100 * RX
  W = FEpaisBordUserfPoint * 2: H = FHautBarreUserfPoint
 .Width = (.Width - W) * RX + W
 .Height = (.Height - H) * RX + H
End With
'réduire si trop large/haut au maxi barre des tâches
With fmME
 SvgZoom = .Zoom: RW = .Width / SvgZoom: RH = .Height / SvgZoom
 Do Until .Width <= FScreenWidthPoint And .Height <= FScreenHeightPointSurBarreTaches
   .Zoom = .Zoom - 1: .Width = .Zoom * RW: .Height = .Zoom * RH
 Loop
End With
fmME.StartUpPosition = 2
'recentrer si passe sous la barre des tâches
If SvgZoom <> fmME.Zoom Then
   With fmME
    .StartUpPosition = 0
    .Top = (FScreenHeightPointSurBarreTaches - .Height) * 0.5
    .Left = (FScreenWidthPoint - .Width) * 0.5
   End With
End If
If PosFmME$ > "" Then 'si pos.écran !?
   LimitB = FEpaisBordUserfPoint: W = FScreenWidthPoint: H = FScreenHeightPointSurBarreTaches
   With fmME
    .StartUpPosition = 0
   Select Case LCase(PosFmME$)
     Case "<haut":          .Top = LimitB: .Left = LimitB
     Case "haut>":          .Top = LimitB: .Left = W - .Width - LimitB
     Case "<haut>", "haut": .Top = LimitB: .Left = (W - .Width) * 0.5
     Case "<bas":           .Top = H - .Height - LimitB: .Left = LimitB
     Case "bas>":           .Top = H - .Height - LimitB: .Left = W - .Width - LimitB
     Case "<bas>", "bas":   .Top = H - .Height - LimitB: .Left = (W - .Width) * 0.5
    Case Else: .StartUpPosition = 2 'centre
   End Select
   End With
End If
End Sub

Public Function FPointsParPixel!(): FPointsParPixel = 0.75: End Function
Public Function FResolutionXwinPixel(): FResolutionXwinPixel = (Application.Width - 12) / FPointsParPixel: End Function
Public Function FResolutionYwinPixel(): FResolutionYwinPixel = (Application.Height + 18) / FPointsParPixel: End Function
Public Function FScreenWidthPoint(): FScreenWidthPoint = FResolutionXwinPixel * FPointsParPixel: End Function
Public Function FScreenHeightPoint(): FScreenHeightPoint = FResolutionYwinPixel * FPointsParPixel: End Function
Public Function FScreenHeightPointSurBarreTaches(): FScreenHeightPointSurBarreTaches = FScreenHeightPoint - FHautBarreDesTachesPoint: End Function
Public Function FHautBarreDesTachesPoint(): FHautBarreDesTachesPoint = 30: End Function
Public Function FEpaisBordUserfPoint(): FEpaisBordUserfPoint = 4: End Function
Public Function FHautBarreUserfPoint(): FHautBarreUserfPoint = 24: End Function

Sub CreatCode()
I = 0
Do: I = I + 1
  M$ = Choose(I, "Userform1", "Userform2", "") '<<< ici le nom des Userforms
  If M$ = "" Then Exit Do
With ActiveWorkbook.VBProject.VBComponents(M$).CodeModule
 x = .CountOfLines + 1
 .InsertLines x, "Private Sub Userform_Activate()": x = x + 1
 .InsertLines x, "'ligne de code": x = x + 1
 .InsertLines x, "'ligne de code": x = x + 1
 .InsertLines x, "'ligne de code": x = x + 1
 .InsertLines x, "End Sub"
End With
Loop
End Sub