Microsoft 365 Impression userform en mode paysage

[romubzh35]

Bonjour à toutes et à tous
j'utilise une macro pour imprimer mon useform mais je n'arrive pas à l'imprimer au format paysage, j'ai essayé quelques petits trucs mais pas moyen.
pourriez vous m'aider svp

Sub impressionForm(usf)
    Dim x, tbl(), i, texte
    x = 0
    With CreateObject("WScript.Network")
        Set imprimantes = .EnumPrinterConnections
        .Orientation = xlLandscape
        For i = 0 To imprimantes.Count - 1
            If InStr(LCase(imprimantes(i)), "pdf") > 0 Then ReDim Preserve tbl(0 To x): tbl(x) = imprimantes(i): texte = texte & x & "--" & imprimantes(i) & vbCrLf: x = x + 1
        Next
        i = InputBox("choissisez  une imprimante " & vbCrLf & texte, "impression userform")
        If i <> "" Then
            .SetDefaultPrinter tbl(Val(i))
            usf.printform
        End If
    End With


End Sub

 

[kiki29]

Salut, à voir/tester

 

[romubzh35]

Salut, à voir/tester

Bonjour non je n'ai que des messages d'erreur

 

[kiki29]

re, j'obtiens ceci ...

 

[romubzh35]

j'ai mis dans le module

Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Const VK_SNAPSHOT = 44
Public Const VK_LMENU = 164
Public Const KEYEVENTF_KEYUP = 2
Public Const KEYEVENTF_EXTENDEDKEY = 1

puis dans le bouton d'impression j'ai mis

Private Sub CommandButton_Print_Click()
'BOITE DE DIALOGUE POUR LA DEMANDE D'IMPRESSION
Dim IPVM
  IPVM = MsgBox("AVEZ-VOUS UNE IMPRIMANTE DE CONNECTEE ?", vbYesNo + vbDefaultButton2 + vbQuestion, " DEMANDE D'IMPPRESSION")
  If IPVM = vbNo Then Exit Sub

  If IPVM = vbYes Then
        Application.ScreenUpdating = False
        DoEvents
        keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
        keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
        DoEvents
        Workbooks.Add
        Application.Wait Now + TimeValue("00:00:01")
        With ActiveSheet
            .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
            .Range("A1").Activate
            .PageSetup.Orientation = xlLandscape
            .PageSetup.LeftMargin = Application.InchesToPoints(0)
            .PageSetup.RightMargin = Application.InchesToPoints(0)
            .PageSetup.TopMargin = Application.InchesToPoints(0.3)
            .PageSetup.BottomMargin = Application.InchesToPoints(0)
            .PageSetup.HeaderMargin = Application.InchesToPoints(0)
            .PageSetup.FooterMargin = Application.InchesToPoints(0)
            .PageSetup.PrintHeadings = False
            .PageSetup.PrintGridlines = False
            .PageSetup.PrintComments = xlPrintNoComments
            .PageSetup.CenterHorizontally = False
            .PageSetup.CenterVertically = False
            .PageSetup.Draft = False
            .PageSetup.PaperSize = xlPaperA4
            .PageSetup.Order = xlDownThenOver
            .PageSetup.BlackAndWhite = False
            .PageSetup.Zoom = 100
        End With
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
        ActiveWorkbook.Close False
        UserForm1.CommandButton1.SetFocus
        Application.ScreenUpdating = True
  End If
End Sub

et j'arrive a un bug sur la partie du code dans le module à chaque fois

 

[patricktoulon]

re
le meilleur moyen est de déterminer le printarea du pagesetup
selon les dimensions du userform
printarea=range("a1",shapes(1)bottomrightcells)
il va de soit que la shapes(1) c'est celle que tu viens de coller (en l’occurrence la capture du userform)

gros somodo comme ceci
je variabilise le classeur temporaire

Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_SNAPSHOT = 44
Private Const VK_LMENU = 164
Private Const KEYEVENTF_KEYUP = 2
Private Const KEYEVENTF_EXTENDEDKEY = 1


Private Sub CommandButton1_Click()
     Dim WbK as workbook
   keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
        keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
        DoEvents
       ' Me.Hide
        Set wbk = Workbooks.Add
        With wbk.Sheets(1)
            .Pictures.Paste
             .PageSetup.PrintArea = .Range("a1", .Shapes(1).BottomRightCell)
            .PageSetup.Orientation = xlLandscape
             .PageSetup.CenterHorizontally = True
            .PageSetup.CenterVertically = True
              .PageSetup.Zoom = 100
        .PrintOut
        End With
         wbk.Close False
       'Me.Show 0
       End Sub