XL 2013 Impression d'un userform

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 !

PHV62

XLDnaute Junior
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
 
bon ben pour le noir et blanc j'ouvre le dialog des options d'imprimante
ca donne la possibilité d'aller a option
VB:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As LongPtr
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
#End If
'uf =l'object userform
'CropCaption =supprime les bordure ou pas (true/false)
'Percentpage=remplace le zoom  de 0 à 100%
'PdfFile = chemin du fichier pdf
Sub PrintFormWithWord(uf As Object, _
                      Optional CropCaption As Boolean = False, _
                      Optional PercentPage As Long = 100, _
                      Optional NoirEtBlanc As Boolean = False, _
                      Optional lPreview As Boolean = False, _
                      Optional PdfFile As String = "")
    
    ' Ajouter word dans les références pour avoir accès aux constantes word
    Dim wdApp As Object ' Word.Application
    Dim wdDoc As Object ' Word.Document
    Dim PaperWidth As Double
    Dim PaperHeight As Double
    Dim TempDouble As Double
    
    Const PaperA4WidthCm = 21
    Const PaperA4HeightCm = 29.7
    
    PercentPage = PercentPage / 100
    
    Call CopyUserFormImageToClipboard(GetActiveWindow)
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    
    ' Créer un document temporaire
    Set wdDoc = wdApp.Documents.Add
    With wdDoc
        .PageSetup.PaperSize = 7
        '.BlackAndWhite = NoirEtBlanc    ' n'existe pas avec Word dommage
    End With
    PaperWidth = 21
    PaperHeight = 29.7
    wdDoc.PageSetup.Orientation = 1 ' paysage
    
    ' Coller le contenu du presse-papiers (image)
    wdDoc.Content.Paste
    
    With wdDoc.InlineShapes(1)
        wdDoc.PageSetup.Orientation = IIf(.Width > .Height, 1, 0)
        If CropCaption Then
            .PictureFormat.CropTop = uf.Height - uf.InsideHeight
            .PictureFormat.CropBottom = 1
            .PictureFormat.CropLeft = 1
            .PictureFormat.CropRight = 1
        End If
        If wdDoc.PageSetup.Orientation = 1 Then
            PaperWidth = Application.CentimetersToPoints(PaperA4HeightCm)
            PaperHeight = Application.CentimetersToPoints(PaperA4WidthCm)
            .Width = (PaperWidth - 2) * PercentPage
            If .Height > PaperHeight - 2 Then .Height = (PaperHeight - 2) * PercentPage
        Else
            PaperWidth = Application.CentimetersToPoints(PaperA4WidthCm)
            PaperHeight = Application.CentimetersToPoints(PaperA4HeightCm)
            .Height = (PaperHeight - 2) * PercentPage
            If .Width > PaperWidth - 2 Then .Width = (PaperWidth - 2) * PercentPage
        End If
        
        .Range.ParagraphFormat.Alignment = 1 'on centre l'image au milieu
    End With
    
    With wdDoc.PageSetup
        .TopMargin = (PaperHeight - wdDoc.InlineShapes(1).Height) / 2
        .BottomMargin = .TopMargin
        .LeftMargin = 0
        .RightMargin = 0
        '.WdVerticalAlignment = wdAlignVerticalCenter
    End With
    
    If PdfFile <> "" Then
        wdDoc.ExportAsFixedFormat OutputFileName:=PdfFile, ExportFormat:=17    ' wdExportFormatPDF
        wdDoc.Close False
        wdApp.Quit SaveChanges:=False
    Else
        If lPreview Then
            wdApp.Activate
            wdApp.ActiveWindow.View.Type = 4
           If NoirEtBlanc Then wdApp.CommandBars.ExecuteMso "FilePrint": ' Exit Sub
             Do While wdApp.ActiveWindow.View.Type = 4
                DoEvents
                Sleep 100 ' Sleep à ajouter dans la déclaration des API
            Loop
        Else
            wdDoc.PrintOut
            End If
     wdDoc.Close False
            wdApp.Quit SaveChanges:=False
       End If
    
   Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

mais c'est long quand même un peu non?
 
Chez moi ça donne ça (en désactivant FasStone Capture) et en utilisant le fichier du Post #85.

1754150116165.png
 
Dernière édition:
@Dudu2 sans doute encore les marge d'ombre qui faussent les calcul du hbitmap mais bon ya pas beaucoup car même avec l'astuce j'aurais toujours une marge bottom plus grande que celle du top
il faut tester avec le bouton ratio (bleu clair) tout les formats( à chaque clicks on change de format)
notamment le ratio A4(1.414...) soit 29.7/21

@halecs93 je ne sais pas quoi te dire
peut être a tu une imprimante paramétrée , déjà
 
Dernière édition:
Ok.
Concernant le code de @nullosse, maintenant je n'arrive plus à imprimer au max de la page.
Il a dû y avoir un setting dans Word qui a bougé.
Du coup, soit j'utilise les marges par défaut soit je suis obligé d'indiquer une marge minimum de 47 points dans les 4 dimensions.
C'est ce fichier. Et je m'arrête là parce que je fatigue sur ce sujet 😩.
 

Pièces jointes

Bonsoir,
[Humour/]
J'ai juste une pensée pour @PHV62 , qui a eu le malheur de poser une simple question....
Et qui maintenant, se retrouve avec 7 pages de discussions, et 97 réponses
Sans savoir où trouver la bonne réponse
Ni, d'ailleurs, si cette réponse existe....
[/Humour]
Bonne soirée, notamment aux 2 [PACA] 😎
 
@patricktoulon,
Avec ton fichier j'ai le même souci.
1754162931543.png


J'ai ça:
VB:
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = CentimetersToPoints(2.11)
        .BottomMargin = CentimetersToPoints(2.11)
        .LeftMargin = CentimetersToPoints(0.3)
        .RightMargin = CentimetersToPoints(1.68)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.25)
        .FooterDistance = CentimetersToPoints(1.25)
        .PageWidth = CentimetersToPoints(29.7)
        .PageHeight = CentimetersToPoints(21)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalCenter
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
 
re:
@Dudu2 a ben si tu met des marges c'est sur ça va marcher beaucoup moins bien

Bonjour @Cousinhub
c'est vrai qu'on ne l'a pas revue(tient ça me rappelle une chanson ça)
peut être est il de ceux qui disent rien (ni merci ni M...)
peut être est il de ceux qui posent une question et ne reviennent jamais (oui ça existe)
peut être est il dead en lisant nos élucubrations 🤣 🤪 ou épuisé(peut plus parler)

bref
mes camarades et moi avons poussé un peu la recherche d'autres solutions moins connues
juste pour le plaisir intellectuel
 
Ok.
Concernant le code de @nullosse, maintenant je n'arrive plus à imprimer au max de la page.
Il a dû y avoir un setting dans Word qui a bougé.
Du coup, soit j'utilise les marges par défaut soit je suis obligé d'indiquer une marge minimum de 47 points dans les 4 dimensions.
C'est ce fichier. Et je m'arrête là parce que je fatigue sur ce sujet 😩.
Salut,
il peut y avoir un problème pour l'application de la mise en page si le document en cours n'est pas dans un état Prêt. Il faut essayer de mettre une temporisation après le coller avant l'application des marges :
VB:
   'Paste the UserForm image to the temporary Word document
    wdDoc.Content.Paste
    Sleep 200
    'Set the Shape size
    With wdDoc.InlineShapes(1)
        wdDoc.PageSetup.Orientation = IIf(.Width > .Height, wdOrientLandscape, wdOrientPortrait)
       
        With wdDoc.PageSetup
            If Not Margins Then
                .LeftMargin = MinimumMarginPoints
                .RightMargin = MinimumMarginPoints
                .TopMargin = MinimumMarginPoints
                .BottomMargin = MinimumMarginPoints
            Else
                .TopMargin = (PaperHeight - wdDoc.InlineShapes(1).Height) / 2
                .BottomMargin = .TopMargin
                .LeftMargin = 0
                .RightMargin = 0
                '.WdVerticalAlignment = wdAlignVerticalCenter
            End If
        End With
Dans l'aperçu avant impression vérifier que c'est bien des marges personnalisées qui sont appliquées :

MargesPrintUserForm.gif


Nullosse
 
Bonjour,
Je comprends pas... Je ne touche pas aux marges qui sont à zéro.

Le Preview

1754199454268.png


Le document Word:

1754199876126.png


Et Dès que j'essaie de modifier des marges il me dit:

1754200300323.png


Si je corrige, alors le Preview:

1754200400041.png
 
Dernière édition:
Ah bon sang, mais c'est bien sûr !
Si l'imprimante est désignée comme étant la Canon MG2950 alors les marges sont imposées sur le Preview même si je les mets à zéro.
Si l'imprimante est désignée comme étant Microsoft Print to PDF alors les marges à zéro sont respectées et le Preview est OK.

Edit: Quand pas de marges, ça remet en question le sizing de la Shape qui ne peut être fait qu'une fois l'imprimante choisie.
Ce choix doit donc être fait en premier lieu.
 
Dernière édition:
Bonjour
moi aussi ce matin ça me fait des bizarrerie
moi j'ai carrément plus de marge mon percentpage se transforme en "1" donc 100 % sans raison
et quand je met 0.8 en dur pour 80% l'impression se fait a au moins 50%
vraiment bizarre ce truc
c'est long
difficile a maintenir
donc pour du 100% pdf c'est bien mais pour imprimer j'irais pas plus loin avec word
 
- 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

Réponses
1
Affichages
227
  • Question Question
XL 2019 User Form
Réponses
9
Affichages
328
  • Question Question
Microsoft 365 affichage userform
Réponses
4
Affichages
374
Réponses
2
Affichages
322
  • Question Question
Microsoft 365 Lecture vocale USF
Réponses
5
Affichages
181
Retour