نحوه گرفتن خروجی پی دی اف از فرم در vba به چه صورت میشود؟

[ali.b]

برای اون حالت من راهی پیدا نکردم
ببنید نیاز نیست حتما اون شیت فعال باشه شما شیت رو مخفی کن همین!! وقتی درخواست داده شد
شما از اکسل انتظار برنامه C رو نداشته باشین.

Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _                                              ByVal bScan As Byte, _
                                              ByVal dwFlags As Long, _
                                              ByVal dwExtraInfo As Long)
Private Const VK_LMENU = &HA4
Private Const VK_SNAPSHOT = &H2C
Private Const VK_CONTROL = &H11
Private Const VK_V = &H56
Private Const VK_0x79 = &H79
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
 
 
Private Sub CommandButton1_Click()
 Dim sAppOs As String
    Dim wks As Worksheet
    'get oparating system
Call d
    
    sAppOs = Application.OperatingSystem
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    If Mid(sAppOs, 18, 2) = "NT" Then
    ' WinNT,Windows2000,WindowsXP - Using Win32API
        Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
        Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
    Else
    ' Windows95,Windows98,WindowsME
        Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
    End If
    DoEvents
    Unload Me
[COLOR=#ff0000]Sheet2.Visible = xlSheetVisible[/COLOR]
[COLOR=#00ff00]    Sheet2.Select[/COLOR]
[COLOR=#00ff00]    Range("A1").Select[/COLOR]
    ActiveSheet.Paste
    'wks.SaveAs Filename:="D:/myfile.htm", FileFormat:=xlHtml
    'wks.Parent.Close False
    Worksheets("ab").PrintPreview
     Application.ScreenUpdating = True
    Application.DisplayAlerts = True
[COLOR=#ff0000]    Sheet2.Visible = xlSheetHidden[/COLOR]
End Sub

این کدهایی که با رنگ قرمز نشون دادم رو قرار بدین مشکلتون حل میشه
رنگ سبز رو هم تو کد قبلی ی سره هست مثل این رنگ جدا کنید

[ne&in]

برای اون حالت من راهی پیدا نکردم
ببنید نیاز نیست حتما اون شیت فعال باشه شما شیت رو مخفی کن همین!! وقتی درخواست داده شد
شما از اکسل انتظار برنامه C رو نداشته باشین.

Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _                                              ByVal bScan As Byte, _
                                              ByVal dwFlags As Long, _
                                              ByVal dwExtraInfo As Long)
Private Const VK_LMENU = &HA4
Private Const VK_SNAPSHOT = &H2C
Private Const VK_CONTROL = &H11
Private Const VK_V = &H56
Private Const VK_0x79 = &H79
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
 
 
Private Sub CommandButton1_Click()
 Dim sAppOs As String
    Dim wks As Worksheet
    'get oparating system
Call d
    
    sAppOs = Application.OperatingSystem
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    If Mid(sAppOs, 18, 2) = "NT" Then
    ' WinNT,Windows2000,WindowsXP - Using Win32API
        Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
        Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
    Else
    ' Windows95,Windows98,WindowsME
        Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
    End If
    DoEvents
    Unload Me
[COLOR=#ff0000]Sheet2.Visible = xlSheetVisible[/COLOR]
[COLOR=#00ff00]    Sheet2.Select[/COLOR]
[COLOR=#00ff00]    Range("A1").Select[/COLOR]
    ActiveSheet.Paste
    'wks.SaveAs Filename:="D:/myfile.htm", FileFormat:=xlHtml
    'wks.Parent.Close False
    Worksheets("ab").PrintPreview
     Application.ScreenUpdating = True
    Application.DisplayAlerts = True
[COLOR=#ff0000]    Sheet2.Visible = xlSheetHidden[/COLOR]
End Sub

این کدهایی که با رنگ قرمز نشون دادم رو قرار بدین مشکلتون حل میشه
رنگ سبز رو هم تو کد قبلی ی سره هست مثل این رنگ جدا کنید

با سلام و احترام
بنده توقع برنامه c ندارم ...بنده هم سوال کردم امکانش هست اول تنظیم کرد بعد پرینت گرفت ؟
چون وقتی کد userform.printform رو قرار میدیم دقیقا از فرم پرینت میگیره ولی عمودی که نصفه هست فقط میخوام افقی باشه کدی هست اضافه بشه کلا بدون اومدن پنجره تنظیمات افقی پرینت بگیره؟

خروجی پی دی اف رو با پرینت اسکرین حل میکنم

[Nooraldin]

سلام
یه فرمی در ماکرو دارم . وقتی که براساس یک table ای سرچ می کنم یه سری اطلاعات درون فرم نمایش می دهد. می خواهم از این اطلاعات مطابق با فرم مورد نظر پرینت بگیرم. کد این پرینت گرفتن چیه ؟
با تشکر

[امين اسماعيلي]

ba dr00o00d

code zir ro emtehan konin bebinim kareton hal mishe, vase man ke kar kard, dar zemn excel baza nabinam hay in narm afzaro ba C va .... moghayesash konina behem bar mikhore, to omram yechizaie didam bahash doros kardan ke ba zabanhaye barnamenevisi dige be in asoni nemishe anjamesh dad. dar ayane nazdic ham ehtemalesh hast zabane payton behesh ezafe beshe darzemn khob ama code

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
    ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

Private Sub CommandButton1_Click()
    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")
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, _
        DisplayAsIcon:=False
    ActiveSheet.Range("A1").Select
    'added to force landscape
    ActiveSheet.PageSetup.Orientation = xlLandscape
    
   
With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With

    ActiveSheet.PageSetup.PrintArea = ""
    
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        '.PrintQuality = 300
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    ActiveWorkbook.Close False
End Sub

ino to formeton copy konin, farz ham bar in ast ke commandbutton1 hamon dokmeie hast ke print form ro baraton anjam mide