Autres impression en pdf d'un userform avec plusieurs pages

[Shikari]

Bonjour forum,
J'ai une version excel 97-2003
Je cherche à imprimer mon userform1, qui comporte plusieurs pages (8) dans un PDF avec un lieu d'enregistrement au choix de l'utilisateur.

merci d'avance

 

[kiki29]

Salut, voir ici et adapter à ton contexte

Il y a qqch de similaire ici:
PDFCreator 1.7.3 Sauver une UserForm en PDF
Excel 2007 Sauver une UserForm en PDF

 

[Shikari]

Bonjour,
Merci pour l'aide mais pour l'instant je n'arrive pas à faire quelque chose de satisfaisant. Je suis obligé de désactiver mon screeshot et ça n'imprime que la 1ere page. J'ai laissé un peu tomber cette histoire et je me concentre à coder mon userform

 

[Shikari]

Bonjour,

pour ceux que ça intéresse, voici "ma" solution:

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)


Private Sub CommandButton2_Click()

Dim i As Single
Dim objFeuilPass As Worksheet

Sleep (50)

'Supprimer/création feuille "impression"
With Application
.DisplayAlerts = False
End With
On Error Resume Next
Sheets("Impression").Delete
Application.DisplayAlerts = True


Sheets.Add.Name = "Impression"
Set objFeuilPass = Sheets("Impression")


'On Error Resume Next
For i = 1 To 9
MultiPage1.Value = i - 1

Me.Repaint
Sleep (50)

'capture écran en simulant l'appui et la relache du bouton Imprécran
keybd_event vbKeySnapshot, 1, 0, 0
DoEvents
Sleep (50)
keybd_event vbKeySnapshot, 0&, &H2, 0&

Application.Wait Now + TimeValue("0:00:01")

objFeuilPass.Paste ' collage Snapshot
With objFeuilPass.Shapes(i) 'redimentionne l'image
.Top = 380 * (i - 1)
.Left = 10
.Height = 300
.Width = 400
End With
Application.DisplayAlerts = True

Sleep (50)

Next i

Worksheets("Impression").Activate
Application.Dialogs(xlDialogPrint).Show



End Sub

 

[patricktoulon]

re
Bonjour @Shikari si ca t’intéresse voici une version qui enregistre chaque page du multipage dans une page du PDF
je n'ai pas utilisé les Apis clipboard j'ai laissé ton wait 1 seconde , mais la gestion d'attente peut être mené différemment avec les api et ce serait plus rapide
l'userform peut avoir la taille ( jusqu ’à une certaine mesure ) et la forme que tu veux c'est tout totomatic
si tu veux voir ce que ca donne sur le sheets bloque la ligne " .delete"
le PDF atterrit sur le bureau automatiquement dans cet exemple
si tu préfère le menu imprimante ou que tu n'a pas le complément save as pdf surprime le paragraphe export

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Sub CommandButton1_Click()

    Dim i&, Rcount&, Ccount&, Place As Range, Chemin$, objFeuilPass As Worksheet, coeffzoom#

    If (Me.Width / 28.3464567) > 21 Then coeffzoom = ((Me.Width / 28.3464567) / 21) - 0.2 Else coeffzoom = 0
    'Supprimer/création feuille "Temporaire"
    With Application
        .DisplayAlerts = False: .ScreenUpdating = False
        On Error Resume Next
        Sheets("Temporaire").Delete
        Err.Clear
        Sheets.Add.Name = "Temporaire": Set objFeuilPass = Sheets("Temporaire")
    End With

    'calcul du nombre de ligne et colonne de la plage pouvant contenir le cliché du userform
    Rcount = Round(2 + (Me.Height + (Me.Height - Me.InsideHeight)) / 15)
    Ccount = Round(0.5 + (Me.Width / 60))

    For i = 0 To MultiPage1.Pages.Count - 1
        MultiPage1.Value = i
        Set Place = [A1].Resize(Rcount, Ccount).Offset(Rcount * i)
        Me.Repaint
        Sleep (50)

        'capture écran en simulant l'appui et la relache du bouton Imprécran
        keybd_event vbKeySnapshot, &H1, &H0, &H0: DoEvents: Sleep (50): keybd_event vbKeySnapshot, 0&, &H2, 0&

        Application.Wait Now + TimeValue("0:00:01")    'pour ca il y a d'autre moyen mais je te le laisse

        objFeuilPass.Paste    ' colle le  Snapshot
        With objFeuilPass.Shapes(i + 1)    'place l'image au centre de la (range ligne/colonne  calculées)
            .Top = Place.Top + ((Place.Height - .Height) / 2)
            .Left = Place.Left + ((Place.Width - .Width) / 2)
        End With
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells((Rcount * i) + 1, 1)    'ajoute un saut de page 1 ligne apres la place
    Next i

    With ActiveSheet.PageSetup
        .PrintArea = [A1].Resize(Place.Cells(Place.Cells.Count).Row, Ccount).Address    'defini l'area global pour le print
        .CenterHorizontally = True: .CenterVertically = True    'imprime au centre de la page
        .Orientation = IIf(Me.Width > Me.Height, xlLandscape, xlPortrait)    'defini l'orientation selon la forme du userform
        .LeftMargin = 0: .RightMargin = 0: .TopMargin = 0: .BottomMargin = 0    ' pas de marge
        .Zoom = 100 / coeffzoom
    End With

    Chemin = Environ("userprofile") & "\Desktop\userform multip.pdf"    ' chemin de sauvegarde du pdf
    With Sheets("Temporaire")
        'export du sheet Temporaire en pdf
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, From:=1, To:=Me.MultiPage1.Pages.Count, OpenAfterPublish:=True
        .Delete    'suppression du sheet temporaire
    End With
    ActiveWindow.SelectedSheets.VPageBreaks(1).Delete    ' au cas ou l'arrondi du calcule  donnerait une colonne en moins de largeur  que la largeur de l'userform
    Application.DisplayAlerts = True

End Sub

 

[Staple1600]

Bonjour le fil

=>patricktoulon
Tu as zappé cette information essentielle

Bonjour forum,
J'ai une version excel 97-2003

 

[patricktoulon]

re
Bonjour Staple1600 j'ai ajouté une phase disant que si il ne veut ou peut pas exporter en pdf il supprime ce paragraphe et se sert du menu impression sur imprimante virtuelle PDF ca change rien ca fonctionne aussi

 

[Staple1600]

Re

patricktoulon
Je voulais juste indiquer que le complément pour Export PDF n'est apparu qu'avec Excel 2007.

PS: Le demandeur n'est pas le seul à lire le fil

NB: C'est ce qui explique le pourquoi de la solution choisie par Shikari
(cf le message#4)

 

[patricktoulon]

re
oui je sais j'ai zappé ce détail au départ
donc pour que se soit plus clair pour le demandeur et tous ceux qui travailleraient avec une version d'excel inferieure a 2007
remplacer ceci

Chemin = Environ("userprofile") & "\Desktop\userform multip.pdf"    ' chemin de sauvegarde du pdf
    With Sheets("Temporaire")
        'export du sheet Temporaire en pdf
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, From:=1, To:=Me.MultiPage1.Pages.Count, OpenAfterPublish:=True
        .Delete    'suppression du sheet temporaire
    End With

par cela

Worksheets("Temporaire").Activate
Application.Dialogs(xlDialogPrint).Show
 Worksheets("Temporaire").Delete    'suppression du sheet temporaire

 

[patricktoulon]

re
@Staple1600
une adaptation avec api clipboard (32bits)plus rapide avec boite de dialogue "enregistrer sous" pour 2007 et +
OU!!
le printerdialog pour les versions inférieures a 2007

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As Integer) As Long

Private Sub CommandButton1_Click()

    Dim i&, Rcount&, Ccount&, Place As Range, Chemin, objFeuilPass As Worksheet, coeffzoom#

    If (Me.Width / 28.3464567) > 21 Then coeffzoom = ((Me.Width / 28.3464567) / 21) - 0.2 Else coeffzoom = 0    'calcul du zomm par raport au coté 21 cm d'une feuille A4
    'Supprimer/création feuille "Temporaire"
    With Application
        .DisplayAlerts = False: .ScreenUpdating = False
        On Error Resume Next
        Sheets("Temporaire").Delete
        Err.Clear
        Sheets.Add.Name = "Temporaire": Set objFeuilPass = Sheets("Temporaire")
    End With

    'calcul du nombre de lignes et colonnes de la plage pouvant contenir le cliché du userform
    Rcount = Round(2 + (Me.Height + (Me.Height - Me.InsideHeight)) / 15)
    Ccount = Round(0.5 + (Me.Width / 60))

    For i = 0 To MultiPage1.Pages.Count - 1
        MultiPage1.Value = i
        Set Place = [A1].Resize(Rcount, Ccount).Offset(Rcount * i)
        Me.Repaint
        Sleep (50)
        WaitPictureClip False    'attentente de vidage du clipboard
        'capture écran en simulant l'appui et la relache du bouton Imprécran
        keybd_event vbKeySnapshot, &H1, &H0, &H0: DoEvents: Sleep (50): keybd_event vbKeySnapshot, 0&, &H2, 0&

        'Application.Wait Now + TimeValue("0:00:01")    'pour ca il y a d'autre moyen (voir ci dessous)
        WaitPictureClip True    'attente de l'image dans le clipboard

        objFeuilPass.Paste    ' colle le  Snapshot
        With objFeuilPass.Shapes(i + 1)    'place l'image au centre de la (range ligne/colonne  calculées)
            .Top = Place.Top + ((Place.Height - .Height) / 2)
            .Left = Place.Left + ((Place.Width - .Width) / 2)
        End With
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells((Rcount * i) + 1, 1)    'ajoute un saut de page 1 ligne apres la place
    Next i

    With ActiveSheet.PageSetup
        .PrintArea = [A1].Resize(Place.Cells(Place.Cells.Count).Row, Ccount).Address    'defini l'area global pour le print
        .CenterHorizontally = True: .CenterVertically = True    'imprime au centre de la page
        .Orientation = IIf(Me.Width > Me.Height, xlLandscape, xlPortrait)    'defini l'orientation selon la forme du userform
        .LeftMargin = 0: .RightMargin = 0: .TopMargin = 0: .BottomMargin = 0    ' pas de marge
        .Zoom = 100 / coeffzoom
    End With

    If Val(Application.Version) >= 12 Then
        'Chemin = Environ("userprofile") & "\Desktop\userform multip.pdf"    ' chemin de sauvegarde du pdf
        Chemin = Application.GetSaveAsFilename(InitialFileName:=Environ("userprofile") & "\Desktop", filefilter:="PDF Files (*.pdf), *.pdf", Title:="ENREGISTREMENT DU PDF")

        If Chemin <> False Then
            With Sheets("Temporaire")
                ActiveWindow.SelectedSheets.VPageBreaks(1).Delete    ' au cas ou l'arrondi du calcule  donnerait une colonne en moins de largeur  que la largeur de l'userform
                'export du sheet Temporaire en pdf
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                     IgnorePrintAreas:=False, From:=1, To:=Me.MultiPage1.Pages.Count, OpenAfterPublish:=True

            End With
        End If

    Else
        Worksheets("Temporaire").Activate
        Application.Dialogs(xlDialogPrint).Show

    End If

    Sheets("Temporaire").Delete    'suppression du sheet temporaire
    Application.DisplayAlerts = True

End Sub

Function WaitPictureClip(Optional sens As Boolean = True)
    Dim v&, x&
    v = Abs(sens): OpenClipboard 0: If v = 0 Then EmptyClipboard
    x = IsClipboardFormatAvailable(2)    '2=bitmap
    Do While x <> v: x = IsClipboardFormatAvailable(2): DoEvents: Loop
    CloseClipboard
    WaitPictureClip = x
End Function

avec une gestion d'attente par l'api "IsClipboardFormatAvailable" on peu aller très vite