Excel模板与Access数据怎样链接？？

ququ

太经典了，要是把注释也加上去，那对初学者简单是太棒了

没牙兔兔

楼上几位老大介绍的方法使用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

我在套用导到EXCEL模板的时候老是提示Dim bks As Excel.Workbooks找不到工程或库，是哪个地方的问题？

paul16

http://posesky.com/bbs/dispbbs.asp?boardID=2&ID=75

ququ

paul16老哥,呵，我要的是ACCESS TO EXCEL 而不是EXCEL TO ACCESS

ququ

这里一定要引用MICROSOFT EXCEL 10。0 OBJECT LIBRARY吗，我引用的是9。0老是出错

ququ

已经OK,原来一定要在OFFICE XP下才行