心随意动下一句:VB DataGrid 的导出或打印

导出到d:\text2.xls中
Private Sub Command2_Click()
Dim i     As Integer
  Dim j     As Integer
  Dim xlApp     As New Excel.Application
  Dim xlBook     As New Excel.Workbook
  Dim xlSheet     As New Excel.Worksheet
  Set xlApp = CreateObject("Excel.Application")
  xlApp.Visible = True
  Set xlBook = xlApp.Workbooks.Add
  On Error Resume Next
  Set xlBook = xlApp.Workbooks.Open("d:\text2.xls")
  Set xlSheet = xlBook.Worksheets(1)
  For j = 0 To DataGrid1.Columns.Count - 1
  xlSheet.Cells(1, j + 1) = DataGrid1.Columns.Item(j).Caption
  Next j
  xlSheet.Cells(6, 1) = "i"
  adodc1.Recordset.MoveFirst
  For i = 0 To adodc1.Recordset.recordcount - 1
  'For j = 0 To DataGrid1.Columns.Count - 1 '这一行跟下一行效果一样
  For j = 0 To adodc1.Recordset.fields.Count - 1
  xlSheet.Cells(i + 1, j + 1) = adodc1.Recordset(j)
  Next j
  adodc1.Recordset.movenext
  Next i
End Sub
提问人的追问   2009-08-15 14:30

用户类型未定义

回答人的补充   2009-08-15 14:49

不好意思，忘记说了 。

在工程——引用里，添加Microsoft Excel 11.0 Object Library即可

回答人的补充   2009-08-15 14:49 提问人的追问   2009-08-15 14:52

恩~~除了标题外~~没有任何内容~

回答人的补充   2009-08-15 14:58 Dim i     As Integer
  Dim j     As Integer
  Dim xlApp     As New Excel.Application
  Dim xlBook     As New Excel.Workbook
  Dim xlSheet     As New Excel.Worksheet
  Set xlApp = CreateObject("Excel.Application")
  xlApp.Visible = True
  Set xlBook = xlApp.Workbooks.Add
  On Error Resume Next
  Set xlBook = xlApp.Workbooks.Open("d:\text2.xls")
  Set xlSheet = xlBook.Worksheets(1)
  For j = 0 To DataGrid1.Columns.Count - 1
  xlSheet.Cells(1, j + 1) = DataGrid1.Columns.Item(j).Caption
  Next j
  xlSheet.Cells(6, 1) = "i"
  Adodc1.Recordset.MoveFirst
  For i = 0 To Adodc1.Recordset.RecordCount - 1
  DataGrid1.Row = i
  For j = 0 To DataGrid1.Columns.Count - 1
  DataGrid1.Col = j
  'MsgBox   DataGrid1.Text
   
  If IsNull(DataGrid1.Text) = False Then
  xlSheet.Cells(i + 2, j + 1) = DataGrid1.Text
  End If
  Next j
  Next i

提问人的追问   2009-08-15 14:59

问下~要是不导出可以直接打印那个DataGrid1里面的内容吗？

回答人的补充   2009-08-15 15:02

可以的！

 

Private Sub Command3_Click()
On Error GoTo ErrMsg
fnt = 15
X = 1000
Y = 1000
Dim i As Long, J As Long, K As Long
Dim PrintString As String
Y = 4400
Printer.CurrentX = 1000
Printer.CurrentY = 4000
Printer.FontSize = 13
Printer.Print "学号/姓名 /课程/成绩/班级"
For i = 0 To DataGrid1.Row
If K = DataGrid1.VisibleRows Then
DataGrid1.Scroll 0, DataGrid1.VisibleRows
K = 0
End If
For J = 0 To DataGrid1.Columns.Count - 1
PrintString = PrintString & _
DataGrid1.Columns(J).CellText(DataGrid1.RowBookmark(K)) & "/"
Next
Printer.CurrentX = 1000
Printer.CurrentY = Y
Printer.FontSize = 10
Printer.Print PrintString
PrintString = ""
K = K + 1
Y = Y + 300
DoEvents
   If i = DataGrid1.Row Then    '无此条件则打印机与计算机不断开，不能进行新的打印任务
Printer.EndDoc
End If
Next
ErrMsg:
  If Err.Number <> 0 Then
     MsgBox CStr(Err.Number) + Err.Description, vbOKOnly + vbCritical, "错误提示"
     Exit Sub
  End If
End Sub