在这里已经等待了很久的问题，没有人给我确切的回答,只好再问问有这方面编程经验的人.紧急等待中...

Question

我的程序里多处用到MSFLEXGRID控件,对这个控件里显示的内容要进行打印,想请问谁有做过msflexgrid控件的打印控件,有的话能否把ocx提供给我.能方便的把显示在msflexgrid控件里的所有内容都打印出来.谢谢了.
email:[email protected]

Answer 1

我以前是用VB中的printer.print直接打印表格中的数据，中间加上线条。出来就是表格了。

Answer 2

'蒋老前辈说的这个吧？Print MSFlexGrid
Here's a quick way to print a MSFlexGrid control's contents: 
    Printer.PaintPicture MSFlexGrid_Name.Picture, 0, 0
    Printer.EndDocAnd if you want it to be the full length of the printer page add this before those two statements: 
    Dim old_width as Integer
    MSFlexGrid_Name.width=printer.widthand this at the end: 
     MSFlexGrid_Name.width=old_width

Answer 3

MSHFLEXGRID已經有人寫好了打印的模塊，
直接調用就行了。你上GOOGLE搜索一下就有了。

Answer 4

一个变通方法：把数据转到EXCEL里就可以了

Answer 5

同意楼上说的,可以通过先导出为EXCEL表,然后再打印..会方便很多..而且质量也不错..我就是这么处理的,一般情况下,我不用外部控件的,如果有什么问题,自己不好找出来..

Answer 6

转到EXCEL中，还需要客户机上支持。
也可以先转成HTML文件。然后自动打开HTML文件，也算是预览了。需要打印就直接打印HTML文件。

Answer 7

如何把显示在msflexgrid里的数据导到excel里去。

Answer 8

Public Function ExportToExcel(RSrecord As ADODB.Recordset, Titles_Name)
'==================================================
'参数说明
'RSrecord ：记录集
'titles_name 表头名称
'蔡健 2006-01-02修改
'==================================================
On Error GoTo ERRCL
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Long
Dim Icolcount As Long
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
   ' 假设Rs_Data 是你的记录集
    With RSrecord
        If .RecordCount < 1 Then
            MsgBox "没有可导出的记录!", vbInformation + vbOKOnly, "提示"
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
      
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    
    Set xlQuery = xlSheet.QueryTables.Add(RSrecord, xlSheet.Range("a2"))
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 8)).Merge
    xlSheet.Cells(1, 1).HorizontalAlignment = xlCenter
    xlSheet.Cells(1, 1) = Titles_Name
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
        xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "宋体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(2, 1), .Cells(Irowcount + 2, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
        
       ' .PageSetup.PaperSize = xlPaperA4    '
       ' .PageSetup.PrintGridlines = True
    End With
xlApp.Application.Visible = True
   
    
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set Rs_Data = Nothing
  Exit Function
ERRCL:  MsgBox "无有效数据或 Excel 2000 未安装！", vbInformation, "错误"
End Function

Answer 9

其实就是打印recordset内的纪录
可以考虑getstring方法来提高效率

Answer 10

這個倒是可以。
優點：簡單。
缺點:效果差，不能一次打印全部數據。----------
Option ExplicitPrivate Sub Command1_Click()
    Printer.PaintPicture MSFlexGrid_Name.Picture, 0, 0
    Printer.EndDoc
    Dim old_width As Integer
    MSFlexGrid_Name.Width = Printer.Width
    MSFlexGrid_Name.Width = old_width
End SubPrivate Sub Form_Load()
    Dim i As Integer
    Dim j As Integer
    Me.MSFlexGrid_Name.Cols = 5
    Me.MSFlexGrid_Name.Rows = 20
    For i = 0 To 19
        For j = 0 To 4
            Me.MSFlexGrid_Name.TextMatrix(i, j) = i
        Next
    Next
End Sub
---------------
www.vicmiao.com
努力就有美好時光！

Answer 11

需要在VB中引用Microsoft Excel xx Object Library (xx依Office版本而有所不同)'功能描述：从列表控件(如MsFlexGrid)中导出到Excel工作表中
'参数:
'    第一个参数表示要导出数据的控件名
'    第二个参数表示在Excel中的列表标题 ,缺省值为: 输出到Excel
'    第三个参数表示Excel编辑密码,缺省值为: 12345
Public Sub MGrid2Excel(ByVal MGrid As MSFlexGrid, Optional szTitle As String = "输出到Excel", Optional szPwd As String = "12345")
Dim ExApp As Excel.Application, ExWb As Excel.Workbook
Dim m As Integer, n As Integer
Dim i As Integer, j As Integer
Dim szColChar As String
Const nFixRow = 3  '指定从Excel第几行开始填充数据Set ExApp = CreateObject("Excel.Application")
Set ExWb = ExApp.Workbooks.Add()On Error GoTo ExcelErrWith ExApp
        .Workbooks.Application.Caption = "Excel报表"
'设置页边距
        .ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.35)
        .ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.35)
        .ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.4)
        .ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.4)
        .ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(0.3)
        .ActiveSheet.PageSetup.CenterHorizontally = True
        
        
        m = MGrid.Rows '行数
        n = MGrid.Cols '列数
        
        szColChar = GetColChar(n) '如果栏数超过26则要进行相关转换
        .Cells(1, 1) = szTitle
        .Range("A1:" & szColChar & "1").Select
        .Selection.HorizontalAlignment = xlCenterAcrossSelection
        .Selection.MergeCells = True
        .Selection.Font.Name = "楷体_GB2312"
        .Selection.Font.FontStyle = "粗体"
        .Selection.Font.Size = 24
        .Selection.Font.ColorIndex = 5
        
'填入数据标题
        For i = 1 To m
            .Cells(nFixRow, i) = MGrid.TextMatrix(0, i - 1)
        Next
        
'填入数据
        For i = 1 To m
            For j = 1 To n
                .Cells(nFixRow + i, j) = MGrid.TextMatrix(i, j - 1)
            Next
        Next
        
'设置网格线
        .Range("A" & nFixRow & ":" & szColChar & (m + nFixRow - 1)).Select
        .Selection.Font.Size = 9
        .Selection.Font.Size = 9
        .Selection.Font.Name = "Times New Roman"
        .Selection.HorizontalAlignment = xlCenter
        .Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Selection.Borders(xlEdgeLeft).Weight = xlThin
        .Selection.Borders(xlEdgeLeft).ColorIndex = 5
        .Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
        .Selection.Borders(xlEdgeTop).Weight = xlThin
        .Selection.Borders(xlEdgeTop).ColorIndex = 5        .Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Selection.Borders(xlEdgeBottom).Weight = xlThin
        .Selection.Borders(xlEdgeBottom).ColorIndex = 5
        .Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
        .Selection.Borders(xlEdgeRight).Weight = xlThin
        .Selection.Borders(xlEdgeRight).ColorIndex = 5        .Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
        .Selection.Borders(xlInsideVertical).Weight = xlHairline
        .Selection.Borders(xlInsideVertical).ColorIndex = 5
        .Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Selection.Borders(xlInsideHorizontal).Weight = xlHairline
        .Selection.Borders(xlInsideHorizontal).ColorIndex = 5
      
'设置打印的固定行及底部显示打印日期及页码  
        .ActiveSheet.PageSetup.PrintTitleRows = "$1:$" & CStr(nFixRow)
        .ActiveSheet.PageSetup.RightFooter = _
        "&""Times New Roman,Regular""&D   &T   &""宋体,Regular""第&""Times New Roman,Regular""&P&""宋体,Regular""页&""Times New Roman,Regular"",&""宋体,Regular""共&""Times New Roman,Regular""&N&""宋体,Regular""页"
     
'设置Excel保护密码
        .ActiveSheet.Protect szPwd, True, True, True
        .Range("A2").Select
End WithExApp.Visible = True
Set ExApp = Nothing
Exit SubExcelErr:
    Resume Next
End SubPrivate Function GetColChar(n As Integer) As String
Dim ss As String
    If n > 26 Then
            ss = Chr((n - 1) \ 26 + 64) & Chr(65 + (n - 1) Mod 26)
    Else
            ss = Chr(64 + n)
    End If
GetColChar = ss
End Function

Answer 12

还没解决吗？已经帮你老早CHECK了。