أريد أن أعمل تقرير ب DataReport بشكل أفقي

السلام عليكم .. من فترة قمت بطرح هذا السؤال وللأسف لم يرد أحد على هذا السؤال .. إلى أن تمكنت من معرفة الأجابة بعد بحث عميق واحببت أن تعم الفائدة

على الجميع .. وعندي طلب صغير إلا وهو أني لم أعرف جميع الأكواد أي لما ترمز إليه فإتمنى أيجاد شرح لهذه الأكواد التي سوف أقوم بكتابته لمعرفة

ما يرمز إليه كل كود .. فأمل المشاركة ... أتحافنا حتى لا نكون مجرد ناقلين .. نسخ وخلاص دون فهم فإرجو مرة أخرى .. أن تكون هناك مشاركة على الموضوع وتثقيف أكثر :rolleyes:

فالنبدأ ....

أولأ سأقوم بعمل موديول وأكتب بداخله ما يلي .... Module

Option Explicit
Global PrintWidth  As Boolean
Global PrinterIsFound  As Boolean

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

'Constants for NT security
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

'Constants used to make changes to the values contained in the DevMode
Private Const DM_MODIFY = 8
Private Const DM_IN_BUFFER = DM_MODIFY
Private Const DM_COPY = 2
Private Const DM_OUT_BUFFER = DM_COPY
Private Const DM_DUPLEX = &H1000&
Public Const DMDUP_SIMPLEX = 1
Private Const DMDUP_VERTICAL = 2
Private Const DMDUP_HORIZONTAL = 3
Private Const DM_ORIENTATION = &H1&

Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integerب
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmLogPixels As Integer
    dmBitsPerPel As Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    dmICMMethod As Long        '// Windows 95 only
    dmICMIntent As Long        ' // Windows 95 only
    dmMediaType As Long        ' // Windows 95 only
    dmDitherType As Long       ' // Windows 95 only
    dmReserved1 As Long        ' // Windows 95 only
    dmReserved2 As Long        ' // Windows 95 only
End Type

Private Type PRINTER_DEFAULTS
    pDatatype As String
    pDevMode As Long
    DesiredAccess As Long
End Type
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long

Private Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, ByVal pDevModeOutput As Any, ByVal pDevModeInput As Any, ByVal fMode As Long) As Long
Public Sub SetOrientation(NewSetting As Long, chng As Integer)
    Dim PrinterHandle As Long
    Dim PrinterName As String
    Dim pd As PRINTER_DEFAULTS
    Dim MyDevMode As DEVMODE
    Dim Result As Long
    Dim Needed As Long
    Dim pFullDevMode As Long
    Dim pi2_buffer() As Long     'This is a block of memory for the Printer_Info_2 structure
    
    PrinterName = Printer.DeviceName
    If PrinterName = "" Then
        Exit Sub
    End If
    
    pd.pDatatype = vbNullString
    pd.pDevMode = 0&
    pd.DesiredAccess = PRINTER_ALL_ACCESS
    
    Result = OpenPrinter(PrinterName, PrinterHandle, pd)
    
    Result = GetPrinter(PrinterHandle, 2, ByVal 0&, 0, Needed)
    ReDim pi2_buffer((Needed \ 4))
    Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)
    
    pFullDevMode = pi2_buffer(7)
    
    Call CopyMemory(MyDevMode, ByVal pFullDevMode, Len(MyDevMode))
    
    MyDevMode.dmDuplex = NewSetting
    MyDevMode.dmFields = DM_DUPLEX Or DM_ORIENTATION
    MyDevMode.dmOrientation = chng
    
    Call CopyMemory(ByVal pFullDevMode, MyDevMode, Len(MyDevMode))
    
    Result = DocumentProperties(Form1.hwnd, PrinterHandle, PrinterName, ByVal pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
    
    Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0&)
    
    Call ClosePrinter(PrinterHandle)
    
    Dim p As Printer
    For Each p In Printers
        If p.DeviceName = PrinterName Then
            Set Printer = p
            Exit For
        End If
    Next p
    Printer.Duplex = MyDevMode.dmDuplex
End Sub

' البحث عن الطابعة هل توجد طابعة مثبته أم لا

Public Function PrinterInstalled() As Boolean
    On Error Resume Next
    PrinterInstalled = CBool(Printer.hDC)
End Function


Public Sub Peportscap()

PrinterIsFound = PrinterInstalled()
If PrinterIsFound = True Then
    Dim PrintW As New PrinterControl
    PrintW.ReSetOrientation
Else
        MsgBox "لا توجد طابعة مثبته.. لن يمكنك البرنامج من مشاهدة الكشوفات", vbMsgBoxRtlReading, "تنبيه"
End If

End Sub

ثم سنعمل كلاس ونضع بداخله الكود التالي ...Class

Option Explicit

Private PageDirection As Integer

Public Sub ChngOrientationLandscape()
PageDirection = 2       'تحويل الطباعة الى الأفقي
 Call SetOrientation(DMDUP_SIMPLEX, PageDirection)
End Sub
Public Sub ReSetOrientation()
 'التغيير بين النوعين
If PageDirection = 1 Then
 PageDirection = 2
ElseIf PageDirection = 2 Then
 PageDirection = 1
End If
Call SetOrientation(DMDUP_SIMPLEX, PageDirection)
End Sub
Public Sub ChngOrientationPortrait()
PageDirection = 1     'إعادة وضع الطابعة الى العمودي
Call SetOrientation(DMDUP_SIMPLEX, PageDirection)
End Sub

ثم نضع هذا الكود تحت زر امر Command

'طباعة
Screen.MousePointer = vbHourglass

'تحديد مصدر التقرير

'Set Report.DataSource = Rs


 ' تحديد وضع التقريرافقي HnHn
'======================================
Call Peportscap
If PrinterIsFound = True And PrinterInstalled = True Then
        'If PrintWidth = True Then GoTo 10
        Dim PrintW As New PrinterControl
        PrintW.ChngOrientationPortrait
        PrintW.ReSetOrientation
        PrintWidth = True
        
    Else
        MsgBox "لم يتعرف البرنامج على طابعة مثبته لديك ..قم بتثبيت الطابعة أولاً", vbMsgBoxRtlReading, "تنبيه"
        Exit Sub
    End If
10 On Error Resume Next
'======================================
'MsgBox "لقد تم تعديل صيغة التقرير الى الوضع العمودي بنجاح" & vbCr & vbCr & "لم يبقى إلا أن تقوم بإظهار التقرير"
Screen.MousePointer = vbNormal


If lID = "" Then
MsgBox "قم بأضافة سجل "
Exit Sub
End If

'بحث عن السجل
sql = "select *  From Table1 ORDER BY typ"
Set rs = db.Execute(sql)


'عرض التقرير إذا كان السجل موجود
'كل الشغل هنا , ومعنا الكود التالي هو وضع مصدر بيانات
'البحث , كمصدر بيانات للتقرير
Set 'DataReport1.DataSource = rs

'عرض التقرير
'DataReport1.Show
'إذا كنت تريد طباعة التقرير بمجرد الضغط على الزر



'إذا لم يجد الرقم بقاعدة البيانات يظهر هذه الرسالة

'If rs.State = adStateOpen Then
'Set rs = Nothing
'End If

:Y :w : :blink: