Office中国论坛/Access中国论坛

标题: Excel模板与Access数据怎样链接？？ [打印本页]

作者: waltonw 时间: 2002-8-26 05:35
标题: Excel模板与Access数据怎样链接？？
想把报表的数据导入到Excel模板中，请各位帮忙能否提供一下思路。

作者: cattjiu 时间: 2002-8-26 16:32
不需要报表了,只要查询就可以了.

作者: waltonw 时间: 2002-8-26 19:17
哦!对呀!我试一下,再来请教.

作者: waltonw 时间: 2002-8-26 22:38
好像位置对不齐,怎样能够指定连接的地方呢?

作者: cattjiu 时间: 2002-8-26 23:05
1. Excel-->Data-->GetExternalData-->New Database Query...-->建立一个MS Query与你的access连接,然后用公式将需要的数据放入另一个格式化了的Excel表里.
2. 用DAO直接将access数据写入Excel表相应格内.

作者: waltonw 时间: 2002-8-27 00:50
啊!太,太复杂了吧!能不能举个例子呢?我对编程是一窍不通啊!谢谢了!

作者: cattjiu 时间: 2002-8-27 00:51
把查询Copy到Excel里贴上.

作者: 李啸林 时间: 2002-8-27 00:52
cattjiu 说得很清楚了，中间并没有编程，只是按了若干次鼠标左键。

作者: waltonw 时间: 2002-8-27 06:02
我想用代码来实现上述过程,一个个设置好像麻烦了些,我的设想是在窗体上能够设一个命令按钮,然后此窗体中的数据能够自动填充到Excel模板中。

作者: waltonw 时间: 2002-8-27 06:44
能实现吗?

作者: sxfwang 时间: 2002-8-27 15:10
通过对象引用,把Excel文件打开,你想改什么都可以啊!

作者: waltonw 时间: 2002-8-27 18:09
能否说的详细一点,是不是在Access中操作呢？好像没有对象引用啊？

作者: HG 时间: 2002-8-27 19:16
waltonw：您就摸著石頭過一次河吧，不過怎知水深淺。

作者: waltonw 时间: 2002-8-27 19:24
好!!我这就去再试一次。谢了!

作者: waltonw 时间: 2002-8-28 19:50
谢谢!基本上已可以实现.

作者: zhengjialon 时间: 2002-8-29 16:54
我也十分要学习这方面的知识，请各位高手多指点，小弟谢了。

作者: waltonw 时间: 2002-8-31 03:14
模板和链接

作者: 大頭 时间: 2003-12-25 08:36
标题: 数据导入到Excel模板中的方法
Private Sub cmdExcel_Click()
  On Error GoTo ErrorHandler
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strOrderDate As Date
Dim strAddress As String
Dim strCustomerName  As String
Dim strWorksheetPath As String
Dim strTemplatePath As String
Dim bks As Excel.Workbooks
Dim wks As Excel.Worksheet
Dim strWorksheet As String
Dim appExcel As Object
Dim strsql As String
Dim intOrderID As Long
Dim strProductName As String
Dim dblUnitPrice As Double
Dim dblQuantity As Double
Dim dblDiscount As Double
Dim intRow As Integer
Set appExcel = GetObject(, "Excel.Application")
strTemplatePath = CurrentProject.Path & "\"
strWorksheet = "OrderDetails.xlt"
strWorksheetPath = strTemplatePath & strWorksheet
Set bks = appExcel.Workbooks
bks.Add strWorksheetPath
'Create variables for information to write to worksheet
strCustomerName = Me![CustomerID]
strAddress = Me![ShipCity] & Me![ShipAddress]
strOrderDate = Me![OrderDate]
Set wks = appExcel.ActiveSheet
'Write to cells in worksheet
With wks
   .Range("C2").Value = strCustomerName
   .Range("C3").Value = strAddress
   .Range("C4").Value = strOrderDate
End With

'Use the ADO connection And Access data
Set cn = CurrentProject.AccessConnection
Set rs = New ADODB.Recordset
intOrderID = Me![OrderID]
  strsql = " SELECT [Order Details].OrderID, Products.ProductName, [Order Details].UnitPrice, [Order Details].Quantity, [Order Details].Discount "
  strsql = strsql & " FROM [Order Details] INNER JOIN Products ON [Order Details].ProductID = Products.ProductID "
  strsql = strsql & " WHERE [Order Details].OrderID = " & intOrderID
With rs
   Set .ActiveConnection = cn
   .Source = strsql
   .LockType = adLockOptimistic
   .CursorType = adOpenKeyset
   .Open
End With
  intRow = 0
Do Until rs.EOF
strProductName = rs![ProductName]
dblUnitPrice = rs![UnitPrice]
dblQuantity = rs![Quantity]
dblDiscount = rs![Discount]
'Use Offset To Locate Cell
wks.Range("B7").Offset(intRow, 0).Value = strProductName
wks.Range("B7").Offset(intRow, 2).Value = dblQuantity
wks.Range("B7").Offset(intRow, 3).Value = dblDiscount
wks.Range("B7").Offset(intRow, 4).Value = dblUnitPrice
wks.Range("B7").Offset(intRow, 5).Value = dblUnitPrice * dblQuantity * (1 - dblDiscount)
intRow = intRow + 1
rs.MoveNext
Loop

'Make worksheet visible
appExcel.Application.Visible = True

Set rs = Nothing
ErrorHandlerExit:
Exit Sub

ErrorHandler:

If Err = 429 Then
   'Excel is not running; open Excel with CreateObject
   Set appExcel = CreateObject("Excel.Application.10")
   Resume Next
Else
   MsgBox "Error No:       " & Err.Number & "; Description: " & Err.Description
   Resume ErrorHandlerExit
End If

End Sub

[此贴子已经被作者于2003-12-25 0:48:35编辑过]

作者: 大頭 时间: 2003-12-25 08:39
标题: 附件
差點忘了
[em07]
[attach]2882[/attach]

[此贴子已经被作者于2003-12-25 0:40:00编辑过]

作者: huanghai 时间: 2003-12-29 18:17
使用EXCEL类，拼命模板文件生成新文件，然后使用ADO读相关记录，并填到对应的单园格，最后生成一个新的EXCEL文件。

作者: ququ 时间: 2004-2-7 19:27
太经典了，要是把注释也加上去，那对初学者简单是太棒了

作者: 没牙兔兔 时间: 2004-2-7 22:02
楼上几位老大介绍的方法使用excel比报表更加灵活
推荐使用,不过导出数据的速度没有报表快
下面的是根据已经设置好的模板，然后把数据导出对应的格子就可以啦
Private Sub cmd打印_Click()

On Error Resume Next
'设定行起始值
  Dim Row As Integer
  '设定列起始值
  Dim Col As Integer
  Dim i As Integer
  Dim Conn As ADODB.Connection
  Dim Rs As ADODB.Recordset
  Dim Strsql As String
  Dim ExcelApp As Excel.Application
  Dim ExcelWst As Excel.Worksheet
  Dim Exltemple As String
  Dim Exloutput As String
  Dim StrRange As String
  Dim txtID As Double
  Dim txtYear As String
  Dim txtname As String

  Set Conn = CurrentProject.Connection
  Set Rs = New ADODB.Recordset

  txtID = [Forms]![frm人员分类统计]![txtID]
  txtname = [Forms]![frm人员分类统计]![txt单位]
  txtYear = [Forms]![frm人员分类统计]![txt年度]

  Strsql = "SELECT qry分类统计.* FROM qry分类统计 WHERE (((qry分类统计.ID) = '" & txtID & "') And ((qry分类统计.年度) = '" & txtYear & "')) Or (((qry分类统计.IDparent) = '" & txtID & "') And ((qry分类统计.年度) = '" & txtYear & "')) ORDER BY qry分类统计.IDparent, qry分类统计.ID"

  Rs.Open Strsql, Conn, 1
  Screen.MousePointer = 11
  Exltemple = IIf(Len(Application.CurrentProject.Path) = 3, Left(Application.CurrentProject.Path, 2), Application.CurrentProject.Path) & "\rpt\人员分类统计表.xls"
  Exloutput = IIf(Len(Application.CurrentProject.Path) = 3, Left(Application.CurrentProject.Path, 2), Application.CurrentProject.Path) & "\temp\" & txtYear & txtname & "_人员分类统计表.xls"
  If IsFileName(Exltemple) = True Then
'直接覆盖临时文件中的模板文件
If IsFileName(Exloutput) = True Then
      '先删除该文件 , 然后再复制
      Kill Exloutput
      FileCopy Exltemple, Exloutput
Else
      '直接复制
      FileCopy Exltemple, Exloutput
End If
  Else
'提示选择模板文件的位置

         MsgBox Exltemple & "文件不存在," & vbCrLf & "请重新选择该文件所在位置!" & vbCrLf & _
            "该文件应该位于" & IIf(Len(Application.CurrentProject.Path) = 3, Left(Application.CurrentProject.Path, 2), Application.CurrentProject.Path) & "\rpt目录中"
'          Me.dlgCommon.CancelError = True
'          Me.dlgCommon.ShowOpen
'
         Dim tmpFileName As String, XLSfile As String
         XLSfile = SelectFileName("人员分类统计表 (*.xls)", "选择模板文件", "选择文件")
         tmpFileName = IIf(InStrRev(XLSfile, "\") > 0, Right(XLSfile, Len(XLSfile) - k), XLSfile)

         If tmpFileName <> "人员分类统计表.xls" Then
            MsgBox "模板文件丢失或选择错误，你不能导出数据！"
            Exit Sub
         End If

  End If



  Err.Clear
  Set ExcelApp = GetObject("", "Excel.Application")
  If Err.Number <> 0 Then
Set ExcelApp = New Excel.Application
  End If
  Err.Clear
' Set ExcelWst = ExcelApp.Workbooks.Add.Worksheets(1)

'Debug.Print Application.CurrentProject.Path
  Set ExcelWst = ExcelApp.Workbooks.Add(Exloutput).Worksheets(1)
  With ExcelWst
.NAME = txtname
   Row = 6
While Not Rs.EOF
      .Cells(Row, 1) = Rs("sname")


      '将字段的内容赋值给相应表格
      For i = 0 + 5 To Rs.Fields.Count - 1
         Select Case i
            Case 5
                  Col = 3
            Case 8
                  Col = Col + 3
            Case 6, 11, 20, 22, 24, 26
                  Col = Col + 2
            Case Else
                  Col = Col + 1
         End Select
         '填入所有相关的值,如果为0的话,就不填啦
         If Rs.Fields(i) > 0 Then
            .Cells(Row, Col) = Rs.Fields(i)
         End If
      Next i
      Row = Row + 1
      Rs.MoveNext
Wend

   '设定打印的格式化
StrRange = "a6:" & .Cells(Row - 1, Col).Address
.Range(StrRange).Font.Size = 9
.Range(StrRange).Orientation = 0
.Range(StrRange).Borders.LineStyle = xlContinuous
.Range(StrRange).Borders.Weight = xlThin
.Range(StrRange).Borders.ColorIndex = xlAutomatic
'

作者: ququ 时间: 2004-2-23 19:42
标题: 找不到工程或库，是哪个地方的问题？
我在套用导到EXCEL模板的时候老是提示Dim bks As Excel.Workbooks找不到工程或库，是哪个地方的问题？

作者: paul16 时间: 2004-2-23 19:45
http://posesky.com/bbs/dispbbs.asp?boardID=2&ID=75

作者: ququ 时间: 2004-2-23 19:52
paul16老哥,呵，我要的是ACCESS TO EXCEL 而不是EXCEL TO ACCESS

作者: ququ 时间: 2004-2-23 22:25
标题: 一定要引用MICROSOFT EXCEL 10。0 OBJECT LIBRARY吗
这里一定要引用MICROSOFT EXCEL 10。0 OBJECT LIBRARY吗，我引用的是9。0老是出错[attach]3604[/attach]

作者: ququ 时间: 2004-2-23 23:28
已经OK,原来一定要在OFFICE XP下才行

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)