怎样打印DATAGRID中的内容

怎样打印DATAGRID中的内容

解决方案 »

  1.   

    form::::::::::::::::Public Sub cmdPrint_Click()  Const Margin As Double = 0.75
      
      Dim print_Port As Boolean
      
      dlgCommon.Flags = cdlPDAllPages Or cdlPDDisablePrintToFile Or cdlPDNoSelection Or Not cdlPDNoPageNums
      
      'Err.Clear
      
      dlgCommon.CancelError = True
       
      dlgCommon.ShowPrinter
      
      If Err.Number = 0 Then
      
        If dlgCommon.Orientation = 1 Then print_Port = Ttue Else print_Port = False
        
        Print_Data_Grid DataGrid1, _
                        Me.Adodc1.Recordset, _
                        print_Port, _
                        Me.chkGrid.Value = vbChecked, _
                        Me.chkHeader.Value = vbChecked, _
                        Me.chkCaption.Value = vbChecked, _
                        CDbl(Me.txtMarginTop.Text), _
                        CDbl(Me.txtMarginBottom.Text), _
                        CDbl(Me.txtMarginLeft.Text), _
                        CDbl(Me.txtMarginRight.Text)
      End IfEnd Sub
    Private Sub Form_Load()
      Me.Width = Me.DataGrid1.Width + 3 * Me.DataGrid1.Left
      Me.Height = Me.Picture1.Top + Me.Picture1.Height + 550
    End Sub
    Private Sub txtMarginLeft_Validate(Cancel As Boolean)  If CDbl(Me.txtMarginLeft.Text) < 0 Then Me.txtMarginLeft.Text = "0.00"
      If CDbl(Me.txtMarginLeft.Text) > 3 Then Me.txtMarginLeft.Text = "3.00"
      
    End SubPrivate Sub txtMarginRight_Validate(Cancel As Boolean)  If CDbl(Me.txtMarginLeft.Text) < 0 Then Me.txtMarginLeft.Text = "0.00"
      If CDbl(Me.txtMarginLeft.Text) > 3 Then Me.txtMarginLeft.Text = "3.00"
      
    End SubPrivate Sub txtMarginTop_Validate(Cancel As Boolean)  If CDbl(Me.txtMarginLeft.Text) < 0 Then Me.txtMarginLeft.Text = "0.00"
      If CDbl(Me.txtMarginLeft.Text) > 3 Then Me.txtMarginLeft.Text = "3.00"
      
    End SubPrivate Sub txtMarginBottom_Validate(Cancel As Boolean)  If CDbl(Me.txtMarginLeft.Text) < 0 Then Me.txtMarginLeft.Text = "0.00"
      If CDbl(Me.txtMarginLeft.Text) > 3 Then Me.txtMarginLeft.Text = "3.00"
      
    End Sub
      

  2.   

    module:::::::::Option ExplicitPublic Const PrintLandscape As Integer = 2
    Public Const PrintPortrait As Integer = 1
    Public Const TwipsPerInch As Integer = 1440
    Public Const MaxHPages As Integer = 16  ' We're using a 2D array of Pagetypes - this is maximum horizontal pages
    Const FontHeightConst = 20    ' used for conversion of font height to default cell heightPublic Type PageType
      StartCol As Integer
      EndCol As Integer
      StartRow As Integer
      EndRow As Integer
    End TypePublic lNumRows As Long
    Public PageNumber As Integer
    Public MaxPages As IntegerSub Print_Data_Grid(dg As DataGrid, rs As ADODB.Recordset, _
                        Portrait As Boolean, _
                        PrintGridlines As Boolean, _
                        PrintHeaders As Boolean, _
                        PrintCaption As Boolean, _
                        Top As Double, _
                        Bottom As Double, _
                        Left As Double, _
                        Right As Double)
                        
    ' Portrait is printer orientation
    ' PrintGridlines specifies whether to print cell gridlines
    ' PrintHeaders specifies whether to print datagrid header cells
    ' PrintCaption specifies printing report header (= caption of datagrid)
    ' Top, Bottom, Left, and Right are the margins in inches.                    
    Dim OldOrientation  As Integer
    Dim PageRow         As Integer  ' Y PAGE Position
    Dim PageCol         As Integer  ' X PAGE PositionDim CurrentPage     As PageType
    Dim Pages()         As PageTypeDim TopMargin       As Integer
    Dim BottomMargin    As Integer
    Dim LeftMargin      As Integer
    Dim RightMargin     As IntegerDim PrintHeight     As Integer
    Dim PrintWidth      As IntegerDim ColumnN         As Integer
    Dim RowN            As IntegerDim RunningWidth    As Double
    Dim RunningHeight   As DoubleDim StdCellHeight   As Single
    Dim HeadHeight      As Single
    Dim CellHeight      As Single
    Dim RowCount        As Long
    Dim iMaxPageCols    As Integer
    Dim iMaxPageRows    As IntegerDim PageStr As String
      ReDim Preserve Pages(MaxHPages, 1)     ' Pages(X, Y) ; X = horizontal page position, Y = vertical
      
      PageNumber = 0
      
      ' Calculate heights
      StdCellHeight = dg.Font.Size * FontHeightConst
      HeadHeight = dg.HeadFont.Size * FontHeightConst * dg.HeadLines
      CellHeight = dg.RowHeight
      
      ' Set Orientation
      OldOrientation = Printer.Orientation
      If Portrait Then
        Printer.Orientation = PrintPortrait
      Else
        Printer.Orientation = PrintLandscape
      End If
      
      ' Determine page breaks
      ' calculate print area (PrintWidth, PrintHeight) & Margins
      TopMargin = Top * TwipsPerInch
      BottomMargin = Printer.Height - (Bottom * TwipsPerInch) ' Relative to Left edge
      LeftMargin = Left * TwipsPerInch
      RightMargin = Printer.Width - (Right * TwipsPerInch)    ' relative to Top Edge
      PrintHeight = BottomMargin - TopMargin
      PrintWidth = RightMargin - LeftMargin
      
      PageRow = 1
      PageCol = 1
      Pages(PageCol, PageRow).StartCol = 1
      RunningWidth = 0
      Pages(PageCol, PageRow).StartRow = 1  Pages(PageCol, UBound(Pages, 2)).EndRow = 1
      
      For ColumnN = 0 To dg.Columns.Count - 1   'loop through cells horizontally
        If dg.Columns(ColumnN).Width >= PrintWidth Then dg.Columns(ColumnN).Width = PrintWidth - 1  ' Make sure that the column will print in one page
        ' We have a page horizontal break here
        If RunningWidth + dg.Columns(ColumnN).Width > PrintWidth Then   ' Check to see that it still fits on printed page
          Pages(PageCol, PageRow).EndCol = ColumnN - 1 ' the last column was the last to fit - Update current row info
          Pages(PageCol + 1, PageRow).StartCol = ColumnN
          Pages(PageCol + 1, PageRow).StartRow = Pages(PageCol, PageRow).StartRow
          PageCol = PageCol + 1   ' Number of Horizontal Pages to be printed.  SB = UBound (Pages,0)
          RunningWidth = dg.Columns(ColumnN).Width    ' Reset running width for next page
          ' and add new
        Else
          RunningWidth = RunningWidth + dg.Columns(ColumnN).Width
        End If
      Next
      
      iMaxPageCols = PageCol
      
      Pages(PageCol, UBound(Pages, 2)).EndCol = ColumnN
      
      ' save column start/stop in Page (PageRow,PageColumn)
      '
      RowCount = 0
      PageCol = 1
      
      If PrintHeaders Then    ' reset the current vertical offset
        RunningHeight = HeadHeight
      Else
        RunningHeight = 0
      End If
      
      Pages(1, 1).StartRow = 1
      
      For RowN = 1 To rs.RecordCount    ' Loop through all the rows vertically
      
        If dg.RowHeight >= PrintHeight Then dg.RowHeight = PrintHeight - 1 ' Make sure that the column will print in one page
        ' We have a page vertical break here
        If (RunningHeight + dg.RowHeight > PrintHeight) Then        ' Check to see that it still fits on printed page
          ReDim Preserve Pages(MaxHPages, PageRow + 1)              ' Add new row of pages & continue
          For PageCol = 1 To iMaxPageCols                           ' Populate the PageRow page data
            Pages(PageCol, PageRow).EndRow = RowN - 1                 ' the last column was the last to fit.
            If PageCol = 2 And PageRow = 1 Then
              Pages(PageCol, PageRow).StartRow = Pages(PageCol - 1, PageRow).StartRow
            End If
            Pages(PageCol, PageRow + 1).StartRow = RowN               ' the next page row start with this row
            Pages(PageCol, PageRow + 1).StartCol = Pages(PageCol, PageRow).StartCol ' current columns = last row's columns
            Pages(PageCol, PageRow + 1).EndCol = Pages(PageCol, PageRow).EndCol
          Next
          
          If PrintHeaders Then          ' Reset running height for next PageRow
            RunningHeight = HeadHeight
          Else
            RunningHeight = 0
          End If
          RunningHeight = RunningHeight + dg.RowHeight
          PageRow = PageRow + 1
        Else
          RunningHeight = RunningHeight + dg.RowHeight
        End If
        
        If RowN = rs.RecordCount Then     ' On last row, save the end row
          For PageCol = 1 To iMaxPageCols
            Pages(PageCol, PageRow).EndRow = RowN
          Next
        End If
        
      Next  'RowN
      

  3.   


      iMaxPageRows = PageRow
      
      MaxPages = iMaxPageRows * iMaxPageCols
      
      ' Now we can print the pages. Pages is array(column,row)of PageType  (Start&End Col, Start&End Row)
      For ColumnN = 1 To iMaxPageCols
        For RowN = 1 To iMaxPageRows
          If PrintHeaders Then
            Printer.Font = dg.HeadFont
            Printer.Font.Size = dg.HeadFont.Size
            Printer.Font.Bold = dg.HeadFont.Bold
            Printheader dg, Pages(ColumnN, RowN), PrintGridlines, Int(Left * TwipsPerInch), Int(Top * TwipsPerInch)
            Printer.Font = dg.Font
            Printer.Font.Size = dg.Font.Size
            Printer.Font.Bold = dg.Font.Bold
            PrintPage dg, rs, Pages(ColumnN, RowN), PrintGridlines, Int(Left * TwipsPerInch), Int(Top * TwipsPerInch) + HeadHeight
          Else
            Printer.Font = dg.Font
            Printer.Font.Size = dg.Font.Size
            Printer.Font.Bold = dg.Font.Bold
            PrintPage dg, rs, Pages(ColumnN, RowN), PrintGridlines, Int(Left * TwipsPerInch), Int(Top * TwipsPerInch)
          End If
          
          ' Print Caption
          If PrintCaption Then
            Printer.CurrentY = 100
            Printer.CurrentX = (Printer.Width - Printer.TextWidth(dg.Caption)) \ 2
            Printer.Print dg.Caption
          End If
          
          ' Print the Page Number
          PageStr = "Page " & PageNumber & " of " & MaxPages
          Printer.CurrentY = Printer.Height - (Bottom * TwipsPerInch) ' + 50
          Printer.CurrentX = (Printer.Width - Printer.TextWidth(PageStr)) \ 2
          Printer.Print PageStr
          
          Printer.NewPage
        Next 'RowN
      Next 'ColumnN
      
      Printer.EndDoc
      
      ' Reset printer orientation
      Printer.Orientation = OldOrientation
      
      Screen.MousePointer = vbNormalEnd SubSub Printheader(dg As DataGrid, ActivePage As PageType, border As Boolean, OffX As Integer, OffY As Integer)
    Dim ColN As Integer
    Dim IndentX As Integer
      
      IndentX = 0
      For ColN = ActivePage.StartCol - 1 To ActivePage.EndCol - 1
        
        PrintCell OffX + IndentX, OffY, Int(dg.Columns(ColN).Width), _
            dg.HeadFont.Size * FontHeightConst * dg.HeadLines, dg.Columns(ColN).Caption, border, True
        IndentX = IndentX + Int(dg.Columns(ColN).Width)
        
      Next ' ColN
      
    End SubSub PrintPage(dg As DataGrid, tmpRS As ADODB.Recordset, _
                  ActivePage As PageType, border As Boolean, _
                  OffX As Integer, OffY As Integer)
    Dim ColN As Integer
    Dim RowN As Integer
    Dim IndentX As Integer
    Dim IndentY As Integer'Dim tmpRS As adodb.Recordset
      
      PageNumber = PageNumber + 1
        
      IndentX = OffX
      IndentY = OffY  ' Was having problems moving through the DG to extract data, so I use the same recordset
      ' used to populate the DG
      tmpRS.MoveFirst
      If ActivePage.StartRow <> 1 Then tmpRS.Move ActivePage.StartRow - 1
      If Not tmpRS.EOF Then
        For RowN = ActivePage.StartRow To ActivePage.EndRow
          For ColN = ActivePage.StartCol - 1 To ActivePage.EndCol - 1
            dg.Col = ColN
            PrintCell IndentX, IndentY, Int(dg.Columns(ColN).Width), Int(dg.RowHeight), "" & tmpRS.Fields(ColN).Value, border, False
            IndentX = IndentX + Int(dg.Columns(ColN).Width)
          Next ' ColN
          IndentY = IndentY + Int(dg.RowHeight)
          IndentX = OffX    ' Reset X offset
          tmpRS.MoveNext
        Next ' RowN
      End If
      'tmpRS.Close
      'Set tmpRS = Nothing
      
    End SubFunction TrimText(Text As String, tWidth As Integer) As String
    Dim l As Integer' Trim the text to fit the cell width, else it will bleed over to the next printed cell  If Printer.TextWidth(Text) <= tWidth Then
        TrimText = Text
      Else
        For l = 1 To Len(Text)
          If Printer.TextWidth(Left(Text, l)) > tWidth Then
            TrimText = Left(Text, l - 1)
            Exit Function
          End If
        Next
      End IfEnd FunctionSub PrintCell(XPos As Integer, YPos As Integer, _
                  Width As Integer, Height As Integer, _
                  Text As String, border As Boolean, Shaded As Boolean)  If Shaded Then
        Printer.FillColor = &HE0E0E0
      Else
        Printer.FillColor = &HFFFFFF
      End If
      
      Printer.FillStyle = 1       ' Opaque
      Printer.Line (XPos, YPos)-(XPos + Width, YPos + Height), Printer.FillColor, BF
      Printer.FillColor = vbWhite  If border Then
        Printer.Line (XPos, YPos)-(XPos + Width, YPos)
        Printer.Line (XPos, YPos)-(XPos, YPos + Height)
        Printer.Line (XPos + Width, YPos)-(XPos + Width, YPos + Height)
        Printer.Line (XPos, YPos + Height)-(XPos + Width, YPos + Height)
      End If
      
      Printer.CurrentX = XPos
      Printer.CurrentY = YPos
      Printer.FillStyle = 1   ' Opaque
      Printer.Print TrimText(Text, Width)
      Printer.FillStyle = 0   ' Transparent
      
      Printer.FillColor = &HFFFFFFEnd Sub