XL 2013 Impression d'un userform

[PHV62]

bonjour le forum
je souhaiterai imprimer un userform avec les informations dans les textbox et combobox grace a un bouton

merci d'avance pour votre aide
ph v

 

[Dudu2]

ON PEUT FAIRE UNE RESSOURCE EN ÉQUIPE SI TU VEUX OU L'ON PROPOSERA LES DEUX VERSIONS
en expliquant le pourquoi du comment du choix de la methode

Moi je veux bien mais tu sais les gens ils veulent une fonction pour imprimer leur UserForm et se moquent de savoir comment ça fonctionne, en plus si il faut leur expliquer le pourquoi du comment de 2 méthodes différentes...

Ce qui me gène (dans nos 2 codes), c'est la simulation du <Alt> + PrintScreen qui peut être intercepté par un outil de Screen Shot (ex. FastStone FScapture) qui empêche le bidule de fonctionner.

 

[patricktoulon]

re
tu centre pas????

 

[patricktoulon]

après j'ai bien d'autre solutions pour capturer mais it 's very API

 

[Dudu2]

tu centre pas????

Si je centre, mais ça centre dans la zone de la page utilisable pour l'impression qui elle-même n'est pas centrée (va savoir pourquoi).
Alors en format paysage ça centre à peu près verticalement et en format portrait ça centre à peu près horizontalement.
Je pense que pour centrer H & V il faudrait réduire la taille de la Shape dans la dimension qui sature.
D'ailleurs ton centrage est plus centré que le mien grâce à ça mais tu remarqueras qu'il souffre également d'un décalage, certes moindre, surtout en mode paysage.

En API tu utilises BitBlt ? Je vais essayer avec ça.

 

[Dudu2]

Je suis pas assez calé pour utiliser BitBlt avec ses "handle to the destination device context", je sais pas ce que c'est.
J'ai récupéré et adapté VBA7 un truc sur stackoverflow.com mais y a des tonnes d'API et ça créé un fichier image, ça ne met pas l'image en Cliboard.
Donc j'en suis au point 0.

 

[Dudu2]

tu centre pas????

Pour revenir sur le centrage, je viens de m'apercevoir que dès qu'on laisse les marges par défaut, le centrage est parfait en V & H.
Dans mes paramètres j'avais un défaut à Margins:=False et je viens de le mettre le défaut à Margins:=True.
Au fond, en agrandissement pleine page, ce n'est pas grave de perdre un peu sur les marges. Le centrage est plus judicieux.

J'ai modifié le fichier du Post #24.
Exemples en paysage et portrait.

 

[patricktoulon]

Si je centre, mais ça centre dans la zone de la page utilisable pour l'impression qui elle-même n'est pas centrée (va savoir pourquoi).

c'est justement ce que j'ai essayé de t'expliquer
quand tu rapproche au plus près de la shape
Excel crée un saut de page vertical
tout simplement par ce qu'il n'y a rien d'autre dans la feuille

le devicecontexte c'est le hdc c'est l'adress du contexte pas de la fenêtre
si tu fait une recherche sur DVP tu trouvera un truc que j'ai fait en 2017 ou 2018 je sais plus
sela dit si tu sais créer une image avec bilblt une fois l'image créée tu la remet dans le clip avec l'api setcliboad data me semble til non ?

 

[patricktoulon]

a oui mais on est plus full size là

 

[Dudu2]

a oui mais on est plus full size là

Non, on est full size avec marges (par défaut) et vraiment centré.
Je trouve que c'est mieux que full size sans marges et décentré.
La différence de taille du UserForm imprimé n'est pas majeure avec les marges car en full size on y voit bien.
Après, avec le paramètre d'appel Margins:=True(défaut)/False, l'utilisateur peut faire ce qu'il veut.

Ok, je vais continuer sur BitBlt. Y a des exemples qui m'éclairent un peu.
Mais demain car là je sature.

 

[patricktoulon]

tiens kado

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
    Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const SRCCOPY As Long = &HCC0020
Private Const CF_BITMAP As Long = 2
Sub SnapshotForm(uf As Object)
    DoEvents ' S'assurer qu'il est visible
    SnapshotInclipBoard FindWindow(vbNullString, uf.Caption)
    MsgBox "UserForm capturé dans le presse-papiers", vbInformation
End Sub
Public Sub SnapshotInclipBoard(ByVal hWnd As LongPtr)
    Dim r As RECT, hSrcDC As LongPtr, hMemDC As LongPtr, hBmp As LongPtr, hOldBmp As LongPtr, largeur As Long, hauteur As Long
        ' Obtenir dimensions  du UserForm avec getwindowRect
    GetWindowRect hWnd, r
    largeur = r.Right - r.Left: hauteur = r.Bottom - r.Top
        ' Obtenir DC de la fenêtre(Dc =device Contexte)
    hSrcDC = GetWindowDC(hWnd) ' on chope le pointeur(address) du device contexte
    hMemDC = CreateCompatibleDC(hSrcDC) ' on crée un device contexte virtuel (en gros un clone)
    hBmp = CreateCompatibleBitmap(hSrcDC, largeur, hauteur) 'on crée un bitmap avec le contexte avec les dimensions du rectangle)
    hOldBmp = SelectObject(hMemDC, hBmp)
        ' Copier l'image
    BitBlt hMemDC, 0, 0, largeur, hauteur, hSrcDC, 0, 0, SRCCOPY
    ' Rétablir bitmap d’origine
    SelectObject hMemDC, hOldBmp
    
    ' allez on fou tout ca dans le clip boarddans clipboard
    OpenClipboard 0: EmptyClipboard: SetClipboardData CF_BITMAP, hBmp: CloseClipboard
    ' Nettoyage
    DeleteDC hMemDC
    ReleaseDC hWnd, hSrcDC
    ActiveSheet.Paste
End Sub

 

[Dudu2]

Bonjour,
Je n'arrive pas à supprimer les marges extérieures du UserForm (voir fichier fonction RemoveDwmExtendFrame()).
Pour palier à ça il faudra retirer le quadrillage, mais on conservera ces marges ombrées, pas terrible.

 

[patricktoulon]

Bonjour @Dudu2
pas forcement
tu triche un peu c'est tout

 WidthPixels = R.Right - R.Left - 2
    HeightPixels = R.Bottom - R.Top - 2

tu n'aura plus l'ombre
ce matin a la fraiche j'ai trouvé encore plus simple
pour le problème de pleine page
en fait on prenait le problème a l'envers
adapter la plage à la shape n'est pas une bonne solution
pour la simple et bonne raison que le ratio de la shape n'est pas forcement pareil que le ratio 29.7/21
je dis bien ratio pas dimension comprenons nous bien

hier je prenait une plage (plus grande arbitrairement) et je prenais la premiere page
et j'adaptais la shapes a la page

aujourd'hui je fais encore mieux
je crée une plage au ratio de A4(landscape ou portrait selon l'userform)
et la j'adapte ma shape a la plage
plus aucun raté c'est du bord a bord
et le Must (plus de zoom,plus de marge,plus de calcul rien du tout on peut utiliser fit to...
et pour le coup je peux même m'amuser a créer mon propre zoom perso qui ne zoom pas mais redimensionne la shape au porcentage demander
du coup j'ai un perfect
et c'est centré

 

[patricktoulon]

re
Bonjour @Dudu2

Alors celle là tu l'aura pas vu venir

on oublie le zoom d'impression
on oublie les saut de pages récalcitrant
on oubli tout ces calculs tordus
on crée une plage AU RATIO DU FORMAT A4

Regarde la simplicité du code
j'en ai presque honte de ne pas y avoir pensé plus tôt
j'ai bloqué le ws.delete pour que tu puisse voir la feuille en mode affichage avec les sauts de pages
pour le snapshot ma fonction avec bitblt peut être adapter c'est pas un problème

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'Fonction pour imprimer ou exporter la capture d'un userform en pleine page
'quelque soit sa taille
'auteur: patricktoulon
'version 4.0
'
'préambule
'Dans cette Version 4.0,
' on ne s'occupe plus du Zoom d'impression on en a plus besoin ( Ni celui de la feuille d'ailleurs )
' on ne s'ocupe plus des saut de pages on en a plus besoin( car il n'y en a plus )
' on utilisera les fonctions natives d'impression dans le pagesetup

'Dans ce nouveau principe :
'1°     Nous allons créer une feuille
'
'2°     Dans cette feuille nous allons considérer une plage au même ratio que le format A4
'       La formule est simple  la plage sera   A1.resize( 29.7/hauteur de A1 , 21/largeur de A1)
'       Bien sur on inverse selon l'userform si il est plus haut que large(orientation)

'3°     Determiner le page setup  avec l'adress de la plage
'       Mettre toute les margeS à zero ainsi que le header et footer
'       On va utiliser les deux fit...
'       On maitrise la couleur qui est une option
'       Et on centre
'
'4°     On colle la capture
'
'5°     On dimensionne et centre la shape en fonction de la plage et du pourcentage demandé
'
'6°     Option de destination destination
'       En fichier pdf
'       Apercu avant  impression
'       Impression
'
'La fonction
'         Arguments
'                  uf As Object                                     'pour l'object userform
'                  Optional nomFichierPDF As String = ""            'chemin pour la sortie en  pdf
'                  Optional BlackAndWhite As Boolean = False        'en couleur ou noir et blanc
'                  Optional percentpage As Double = 100             'pourcentage de 0 à 100 de la page pour  la capture
'                  Optional lpreview As Boolean = False) As Boolean 'apercu avant impression



#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If

Sub snapshotForm()
    keybd_event &H12, 0, 0, 0
    keybd_event &H2C, 0, 0, 0
    keybd_event &H2C, 0, &H2, 0
    keybd_event &H12, 0, &H2, 0
    DoEvents
End Sub

Public Function PrintFormX( _
                           uf As Object, _
                           Optional nomFichierPDF As String = "", _
                           Optional BlackAndWhite As Boolean = False, _
                           Optional percentpage As Double = 100, _
                           Optional lpreview As Boolean = False) As Boolean
  
    Dim ws As Worksheet, shp As Shape, RnG As Range, w#, H#
  
    snapshotForm 'CAPTURE
    uf.Hide
  
    Set ws = Sheets.Add
    DoEvents
  
    'determine la largeur en point pour le format A4 et l'orientation
    If uf.Width > uf.Height Then
        ws.PageSetup.Orientation = xlLandscape
        w = Application.CentimetersToPoints(29.7)
        H = Application.CentimetersToPoints(21)
    Else
        ws.PageSetup.Orientation = xlPortrait
        w = Application.CentimetersToPoints(21)
        H = Application.CentimetersToPoints(29.7)
    End If
  
    'creation d'une plage(Rng) au ratio A4 directement!!!!!!!!
    Set RnG = ws.[A1].Resize(H / ws.[A1].Height, w / ws.[A1].Width)
  
    'le page setup on met tout a zero(marge et header),on centre et on fit tout simplement
    With ws.PageSetup
        .PaperSize = xlPaperA4
        .PrintArea = RnG.Address
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .LeftMargin = 0
        .RightMargin = 0
        .TopMargin = 0
        .BottomMargin = 0
        .HeaderMargin = 0
        .FooterMargin = 0
        .Zoom = False 'pas de zoom
        .CenterHorizontally = True
        .CenterVertically = True
        .BlackAndWhite = BlackAndWhite
    End With
  
    'on colle la capture
    ws.Paste
  
    'on place et dimentionne la shape(capture)
    With ws.Shapes(1)
        .Width = RnG.Width * (percentpage / 100)
        If .Height > RnG.Height Then .Height = RnG.Height * (percentpage / 100)
        .Left = (RnG.Width - .Width) / 2
        .Top = (RnG.Height - .Height) / 2
    End With
  
    'JUSTE pour la demo on affiche le mode avec saut de page
    ActiveWindow.View = xlPageBreakPreview
  
    'destination
    If nomFichierPDF <> "" Then
        'en pdf
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomFichierPDF, Quality:=xlQualityStandard, _
                                                  IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Else
        'si preview demandé
        If lpreview Then
            ws.PrintPreview
        Else
            'sinon on imprime tout court
            ws.PrintOut
        End If
    End If
  
    'on supprime la feuille on en a plus besoin
    Application.DisplayAlerts = False
    'ws.Delete
    Application.DisplayAlerts = False
    uf.Show 0
  
End Function

allez voici un fichier de test
tu trouvera pas mieux a mon avis
d'ailleurs je vais changer la ressource pour celle ci

 

[Dudu2]

Ok, c'est bien, tu as une méthode intéressante pour imprimer qui fonctionne bien.

Mais puis-je te faire remarquer que:

1. Puisque tu utilises toujours un <Alt> + PrintScreen, ça n'apporte rien de plus par rapport au fichier du Post #24.
   
   
2. Le but c'est de se débarrasser ce <Alt> + PrintScreen (avec le code que tu as fourni avec je suppose l'aide de ChatGpt) qui est intercepté par les logiciels de capture d'écran qu'il faut désactiver avant.
   J'ai FastStone FSCapture qui tourne en permanence chez moi et la méthode <Alt> + PrintScreen ne fonctionne simplement pas.

 

[patricktoulon]

non le but c'est toi qui te le donne le sujet de cette discussion c'est d'imprimer un uf pleine page
je n'apporte rien de plus ? c'est quand même moi qui t'ai donné ma fonction perso clipboard
d'ailleurs si tu cherche bien sur DVP, tu trouvera la même mais qui permet de faire avec bitblt mais avec l'userform placer n'importe ou même entre deux écrans sans couper la capture cherche avec patricktoulon ou patmeziere (ca date un peu)

perso tout au long de ces tests mon but a moi c'est d'optimiser et garantir un full page au mieux
en évitant d'usiner ,d'ailleurs elle est plus rapide que tout ce que l'on a fait tout les deux jusqu’à maintenant

le snapshot chacun utilise ce qu'il veut moi ce qui m'importe c'est une mécanique sure ne dépendant pas d'api que certains éviteront
d'ailleurs si je pouvait me passer de keyb_event je serais ravi
je regarde si je peux utiliser l'outils de la capture de excel en ce moment comme ça on sera tout bon
mais c'est une autre histoire