HELP！！各位专家帮帮小弟！！

Question

从"工程/引用"中引用EXCEL对象库,然后新建工作簿工作表等对象直接向单元格写数据.

Answer 1

我这里有个Word的例子，Excle应该也是一样的，希望对你有帮助！Dim WithEvents objWord As Word.Application
Dim WithEvents curWordDocument As Word.Document
    Dim i, j As Integer
    Dim curDocumentPath As String
    Dim curCell As clsCell
    Dim curEmbedObject As NotesEmbeddedObject
    
    IsOkOrCancel = False
    printTemplatePath = ""
    Set objWord = New Word.Application
    Set curWordDocument = objWord.DOCUMENTS.Add(, , wdNewBlankDocument)
    Call curWordDocument.SaveAs(printTemplatePath)
    IsAddNewData = True        
             objWord.Selection.Font.Bold = True
            objWord.Selection.Font.Size = 22
            objWord.Selection.TypeText Join(curForm.DisposalName, ",")
            objWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
            objWord.Selection.TypeParagraph
            objWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
            objWord.Selection.Font.Bold = False
            objWord.Selection.Font.Size = 10.5
            objWord.Selection.TypeParagraph
            For i = 1 To curForm.RowNumber
                For j = i To curForm.RowNumber * curForm.ColNumber Step curForm.RowNumber
                    Set curCell = curForm.GetCells(j)
                    If curCell.IsUsed = True Then
                        objWord.Selection.TypeText curCell.CellCaption
                        objWord.Selection.TypeText vbTab
                        If curCell.CellControlType = FNothing Then
                            objWord.Selection.TypeText vbTab
                        Else
                            objWord.Selection.TypeText "щ"
                            objWord.Selection.TypeText curCell.CellControlName
                            objWord.Selection.TypeText "щ"
                        End If
                        objWord.Selection.TypeText vbTab
                    Else
                        objWord.Selection.TypeText vbTab
                        objWord.Selection.TypeText vbTab
                        objWord.Selection.TypeText vbTab
                        objWord.Selection.TypeText vbTab
                        objWord.Selection.TypeText vbTab
                    End If
                Next j
                objWord.Selection.TypeParagraph
                
            Next i

Answer 2

'这个模块用于将记录集数据导出到Excel并打印.首先,用户必须安装了Microsoft Excel
'需要在“工程/引用”中添加：
'1,Microsoft Excel (9.0) Object Library
'2,Microsoft ActiveX Data Objects (2.0) Library
'
'rstToExcel过程用于将记录集数据导出到Excel并打印。
'该过程使用一个therst参数传入一个当前打开的记录集。
'然后调用 rstToExcel (记录集名) 即可导出并打印。如：
'Private Sub Form_Load()
'  Dim rst As Recordset
'  Set rst = New Recordset
'  rst.CursorLocation = adUseClient
'  rst.Open "SELECT * FROM [authors]", "Provider=SQLOLEDB.1;Password=;Persist Security Info=True;User ID=sa;Initial Catalog=pubs;Data Source=www.abc.com", adOpenStatic, adLockOptimistic
'  rstToExcel rst
'End Sub
'
'附：如果记录集较长需要出现进度提示，可以传入rstToExcel的第二个可选参数TipForm，
'TipForm:一个进度提示窗体,从"工程/添加窗体"中添加一个空白窗体(将窗体的Caption设为空，Controlbox设为False.Visible设为False),然后在上面绘制一个Progressbar控件(注意：必须绘制一个Progressbar进度条控件，名为Progressbar1.)
'调用如：rstToExcel rst,Form2
'
Option ExplicitPrivate theExcel As Excel.Application
Private aBook As Workbook
Private aSheet As Worksheet
Private aRange As Range
Dim rst As Recordset
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Sub rstToExcel(therst As Recordset, Optional TipForm As Variant)
  Dim cLine As Long
  Dim TipNum As Long
  Dim ColHeader As Integer, Col As Integer
  Set theExcel = CreateObject("Excel.Application")
  theExcel.Visible = True
  Set aBook = theExcel.Workbooks().Add
  Set aSheet = aBook.Worksheets("sheet1")
  Set rst = therst
'-------------------1,填充数据
On Error GoTo ErrOut:
  If rst.BOF And rst.EOF Then Exit Sub
  
  
  If IsMissing(TipForm) = False Then
      TipForm.Show
      TipForm.Move (Screen.Width - TipForm.Width) / 2, (Screen.Height - TipForm.Height) / 2
      SetWindowPos TipForm.hwnd, -1, 0, 0, 0, 0, &H3
      TipForm.ProgressBar1.Min = 0
      rst.MoveFirst: rst.MoveLast
      TipForm.ProgressBar1.Max = rst.RecordCount
      If TipForm.ProgressBar1.Max = 0 Then TipForm.ProgressBar1.Max = 100
      TipForm.ProgressBar1.Value = 0
      DoEvents
  End If
  
  cLine = 1
  For ColHeader = 0 To rst.Fields.Count - 1
    aSheet.Cells(cLine, ColHeader + 1) = rst.Fields(ColHeader).Name
  Next ColHeader
  rst.MoveFirst
  Do While Not rst.EOF
    cLine = cLine + 1
      For Col = 0 To rst.Fields.Count - 1
        aSheet.Cells(cLine, Col + 1) = rst.Fields(Col).Value
      Next Col
    aSheet.Range("A" & cLine).Select
    rst.MoveNext
    If IsMissing(TipForm) = False Then
      TipNum = TipNum + 1
      TipForm.ProgressBar1.Value = TipNum
      If TipForm.ProgressBar1.Value >= TipForm.ProgressBar1.Max Then TipForm.ProgressBar1.Value = 0
    End If
  Loop
  rst.MoveFirst
  If IsMissing(TipForm) = False Then Unload TipForm
  
  
'--------------2,设置格式
aSheet.Columns.AutoFit '自动调整列宽
Set aRange = aSheet.Range("A1")
aRange.AutoFormat Format:=xlRangeAutoFormatSimple, Number:=True, Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
'格式2(可选):aRange.AutoFormat Format:=xlRangeAutoFormatColor2, Number:=True, Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
'格式3(可选):aRange.AutoFormat Format:=xlRangeAutoFormatList1, Number:=True, Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True'---------------3,打印
aSheet.PageSetup.PrintGridlines = True
aSheet.PrintPreview
'直接打印：aSheet.PrintOut Copies:=1, Collate:=True '其中，Copies参数为打印份数，Collate是否逐份打印。
   '---------------4,结束
ErrOut:
  If Err.Number <> 0 Then
    If Err.Number = 438 Then '进度提示窗体上未放置Progressbar1时发生此错误
      Resume Next
    Else
      MsgBox Err.Description, vbInformation
    End If
  End If
  Set aRange = Nothing
  Set aSheet = Nothing
  Set aBook = Nothing
  Set theExcel = Nothing
End Sub