1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
| Option Explicit
Declare Function fwa Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Dim handle As Long, topframe As Long, leftframe As Long, heightme As Long, widthme As Long, X As Long
Dim largeframe As Long, hautframe As Long
Dim diviseur
Dim ctrl As Object
Sub impression_frames(usf As Object, laframe As Object)
'on memorise la taille initial du userform
heightme = usf.Height
widthme = usf.Width
'on memorise la position initiale de la frame
topframe = usf.Controls(laframe.Name).Top
leftframe = usf.Controls(laframe.Name).Left
largeframe = usf.Controls(laframe.Name).Width
hautframe = usf.Controls(laframe.Name).Height
' ici on reprend l'idée de fring(invisibilité de tout les controls)
With usf
'rendre tous les contrôle du Userform1 invisibles
For Each ctrl In .Controls
If ctrl.Name <> "frame1" Then
If ctrl.Parent.Name = usf.Name Then ctrl.Visible = False
Else
ctrl.Visible = True
End If
Next
usf.Frame1.Visible = True
End With
'on trouve le handle
handle = fwa(vbNullString, usf.Caption)
'on suprime la caption du userform
SetWindowLong handle, -16, GetWindowLong(handle, -16) And Not &HC00000 '*
'on deplace la frame a gauche et en haut
usf.Controls(laframe.Name).Move 0, 0, usf.Controls(laframe.Name).Width, usf.Controls(laframe.Name).Height
'ici on reduit au maximum que la page 21,29.7 peut supporter
diviseur = usf.Controls(laframe.Name).Width / 650
usf.Controls(laframe.Name).Width = usf.Controls(laframe.Name).Width / diviseur
usf.Controls(laframe.Name).Height = usf.Controls(laframe.Name).Height / diviseur
'on met les control au proportion de la frame
For Each ctrl In usf.Controls(laframe.Name).Controls
ctrl.Move ctrl.Left / diviseur, ctrl.Top / diviseur, ctrl.Width / diviseur, ctrl.Height / diviseur
On Error Resume Next
ctrl.FontSize = ctrl.FontSize / diviseur
On Error GoTo 0
Next
'on aplique les dimentions de la frame a lcelle de l'userfom
usf.Height = usf.Controls(laframe.Name).Height + 4
usf.Width = usf.Controls(laframe.Name).Width + 4
usf.Controls("TextBox1").Value = usf.Controls(laframe.Name).Width
usf.Repaint
'on imprime l'userform
usf.printform
'on remet tout a l'initial
SetWindowLong handle, -16, GetWindowLong(handle, -16) Or &HC00000 '*
usf.Height = heightme
usf.Width = widthme
usf.Controls(laframe.Name).Move leftframe, topframe, largeframe, hautframe
'on met les control au proportion de la frame
For Each ctrl In usf.Controls(laframe.Name).Controls
ctrl.Move ctrl.Left * diviseur, ctrl.Top * diviseur, ctrl.Width * diviseur, ctrl.Height * diviseur
On Error Resume Next
ctrl.FontSize = ctrl.FontSize * diviseur
On Error GoTo 0
Next
For Each ctrl In usf.Controls
ctrl.Visible = True
Next
End Sub |