Userform.Print komutunda yatay yazdırma ayarlaması

[cout(h)ane]

Merhaba,

Siteyi aradım ancak bu konu ile ilgili cevapsız birkaç soru bulabildim ancak. Belki konuyu tekrar gündeme getirmek iyi olabilir.

Hazırladığım userform'un eni geniş olduğu için, "userform1.print" kodu ile çıktı aldığımda tümünü göremiyorum. Eğer yatay yazdırma ile ilgili bir kod bilen var ise yardımcı olabilir mi?

 

[Ali]

Kodlarınızın içine

ActiveSheet.PageSetup.Orientation = xlLandscape

kısmını ilave edin

 

[cout(h)ane]

Sn.Fructose,

Öncelikle cevabınız için teşekkür ederim.

Ancak sizin verdiğiniz kodlar "SAYFA"nın yazdırılmasında yardımcı olabilir. Ben ise "USERFORM"u yazdırmak istiyorum.

"userform1.pagesetup.orientation..." gibi kodlamalar denedim ama biraz zihni sinir çabalamaları gibi oldu

Başka bir çözüm önerisi olan var mıdır?

 

[Ali]

Sizden sonra biraz araştırdıkdan sonra aşağıdaki kodları buldum.

Modüle aşağıdaki kodları kopyalayın.

Option Explicit

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

Const VK_SNAPSHOT = &H2C


Const KEYEVENTF_KEYUP = &H2
Const VK_MENU = &H12


Public SH As Worksheet

Sub page_setup(UFW, UFH)

   
    Dim RNG As Range
    Set RNG = Range("A1:C3")
    With SH
        .Paste RNG(1)
        DoEvents
        .PageSetup.PrintArea = RNG.Address
        RNG.ColumnWidth = .Shapes(1).Width * 0.180375 / RNG.Columns.Count
        RNG.RowHeight = .Shapes(1).Height / RNG.Rows.Count
        With .PageSetup
            .LeftMargin = Application.InchesToPoints(0)
            .RightMargin = Application.InchesToPoints(0)
            .TopMargin = Application.InchesToPoints(0)
            .BottomMargin = Application.InchesToPoints(0)
            .HeaderMargin = Application.InchesToPoints(0)
            .FooterMargin = Application.InchesToPoints(0)
         
            .CenterHorizontally = True
            .CenterVertically = True
            .Orientation = IIf(UFW < UFH, xlPortrait, xlLandscape)
        End With
        .PrintOut Copies:=1, Collate:=True
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    
End Sub




Sub CopyActiveForm()
    keybd_event VK_MENU, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End Sub

Userformunuzdaki butonunuza aşağıdaki kodları ekleyin

Option Explicit

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    Set SH = Sheets.Add
    CopyActiveForm
    Call page_setup(Me.Width, Me.Height)
    Unload Me
 End Sub

 

[Ali]

Başka bir örnek ise aşağıdaki linkte mevcuttur.

http://www.mrexcel.com/board2/viewtopic.php?p=956374&highlight=dwflags#956374