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]

Bonjour @patricktoulon,
En effet, cette astuce permet d'occuper tout l'espace de la page.
Bien trouvé !

 

[Dudu2]

Bonjour @nullosse,
Les variables wdPaperA4, wdOrientLandscape, wdAlignParagraphCenter apparaissent chez moi comme non déclarées.
Elles viennent d'où ?

 

[job75]

Bonjour,

Les variables wdPaperA4, wdOrientLandscape, wdAlignParagraphCenter apparaissent chez moi comme non déclarées.

Ce sont des constantes utilisées dans le VBA de Word

Si on veut les utiliser dans le VBA d'Excel il faut les remplacer par leurs valeurs numériques :

wdPaperA4 => 7, wdOrientLandscape => 1, wdAlignParagraphCenter => 1.

A+

 

[nullosse]

Bonjour @nullosse,
Les variables wdPaperA4, wdOrientLandscape, wdAlignParagraphCenter apparaissent chez moi comme non déclarées.
Elles viennent d'où ?

Salut,
c'est comme j'ai indiqué il faut mettre la Microsoft Word object Library dans les références du VBA et comme cela on accède à toutes les constantes VBA de word.
Nullosse

 

[Dudu2]

Ok merci @job75.
Et pas vu ta remarque @nullosse.
Il est vrai qu'avec la méthode à @nullosse, on peut obtenir une utilisation complète de la feuille.
Il faudrait (ce que je n'ai pas fait, seulement en approximations répétées) savoir calculer:
- wdDoc.InlineShapes(1).ScaleHeight et .ScaleWidth
- savoir soit centrer verticalement (wdDoc.PageSetup.WdVerticalAlignment ne fonctionne pas) ou calculer les marges.

 

[Dudu2]

En fait les .ScaleHeight et .ScaleWidth ne fonctionnent pas en réduction.
Suffit d'utiliser .Height et .Width.
Le centrage vertical est fait via les TopMargin et BottomMargin.

La version de @nullosse avec utilisation pleine page.

Edit: L'impression pleine page en grossissement maximum ça peut être utile, mais perso je vais rester sur l'impression Excel en grossissement maximum avec les marges Excel par défaut qui réservent un peu d'espace autour.
Il est bien sûr possible dans le code de @nullosse de réserver des marges en réduisant la taille de la Shape finale des marges utilisées.

 

[patricktoulon]

ton fichier ne peut être téléchargé @Dudu2

et l'exemple de @nullosse impossible d'y arriver chez moi
j'ai pourtant remplacé les constantes par leur numériques
j'ai fait le prorata pour l’échelle verticale et horizontale
rien n'y fait
je précise que j'ai testé avec un userform avec un ratio 1.414xxxx qui est celui du 29.7/21
autrement dit le userform doit remplir toute la feuille en paysage (moins les petite marges éventuellement demandées

 

[Dudu2]

ton fichier ne peut être téléchargé @Dudu2

J'étais peut-être en train de le recharger après des petites modifs de présentation.

 

[patricktoulon]

ok ca match Impec 👍
j'ai ajouté le percentPage de 0 à 100% comme ça on touche pas au marge puisque c'est centré

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

Sub PrintWithWord()
    ' 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
    
    Const percentPage = 90 / 100 'exemple ici 90%
    
    Call CopyUserFormImageToClipboard(GetActiveWindow)
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    
    ' Créer un document temporaire
    Set wdDoc = wdApp.Documents.Add
    wdDoc.PageSetup.PaperSize = 7
    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 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

    wdApp.ActiveWindow.View.Type = 4
    
    Do While wdApp.ActiveWindow.View.Type = 4
        DoEvents
        Sleep 100 ' Sleep à ajouter dans la déclaration des API
    Loop
    
    wdDoc.Close False
    
    ' Quitter Word si on l'a lancé depuis VBA
    wdApp.Quit SaveChanges:=False
    Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

 

[patricktoulon]

re
Comme quoi tu vois on avait pas tout exploré 😉
je donne quand même la version 2017 remis au gout du jour de la printFormX1
utilisant une plage grande(plusieurs pages et impression page1

 

[Dudu2]

Ok, bonne idée ce pourcentage.
Je crois qu'on a perdu depuis longtemps l'auteur du sujet @PHV62, surement débordé par nos élucubrations. 😛

 

[halecs93]

re
Comme quoi tu vois on avait pas tout exploré 😉
je donne quand même la version 2017 remis au gout du jour de la printFormX1
utilisant une plage grande(plusieurs pages et impression page1

Bonjour, je suis "quotidiennement" vos échanges.... mais, voilà le résultat que j’obtiens chez moi..... le Userform semble être tronqué ....

 

[patricktoulon]

re
tiens
j'ai bloqué les close et quit il faudra gérer selon la revoilà avec la toale

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 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
    
    Call CopyUserFormImageToClipboard(GetActiveWindow)
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    
    ' Créer un document temporaire
    Set wdDoc = wdApp.Documents.Add
    wdDoc.PageSetup.PaperSize = 7
    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
    Else
    wdDoc.ExportAsFixedFormat OutputFileName:=PdfFile, ExportFormat:=17, OpenAfterExport:=False, _
    OptimizeFor:=0, Range:=0, Item:=0, IncludeDocProps:=True
    wdApp.ActiveWindow.View.Type = 4
    End If
    
    Do While wdApp.ActiveWindow.View.Type = 4
        DoEvents
        Sleep 100 ' Sleep à ajouter dans la déclaration des API
    Loop
    
    'wdDoc.Close False
    
    ' Quitter Word si on l'a lancé depuis VBA
    'wdApp.Quit SaveChanges:=False
    Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

 

[patricktoulon]

dommage le blackandwhite n'existe pas pour le page setup d'un document word
sinon full option comme la mienne

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
        Else
            wdDoc.PrintOut
            wdDoc.Close False
            wdApp.Quit SaveChanges:=False
        End If
    End If
    
    Do While wdApp.ActiveWindow.View.Type = 4
        DoEvents
        Sleep 100 ' Sleep à ajouter dans la déclaration des API
    Loop
    
    '
    
    ' Quitter Word si on l'a lancé depuis VBA
    'wdApp.Quit SaveChanges:=False
    Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

 

[patricktoulon]

bonjour @halecs93
là je ne vois pas ce qui pourrait bien te couper l'image en deux le problème vient d'ailleurs a mon avis
j'ai testé sur 2013 2016 et 2021 et je n'ai aucune différence