输出为Excel报表文件时遇到的一个极为讨厌的问题

没牙兔兔

将access表里的值导入到excel文件中
因为 该数据表的列很多,所以excel一屏显示不完,使用的是excel自带的分页打印

但是这样每次输出完数据后,excel都定位到最后一列
然后你如果要查看报表的话,必须 拖动一下滚动条,每次都这样,很讨厌
嘻嘻,不知道有没有哪位大侠给点意见 怎么解决

没牙兔兔

呵呵,刚刚看到这句话
比较有趣

"ERP不是老实人能干的，基本上需要有些骗子的天赋"

发上来,顺便顶顶自己的问题

ADAM

你輸入到excel中時
用range,或cell及select選定資料範圍
如:
app為excel物料
app.workbooks("XX").WORKSHEETS("SHEET1").RANGE(CELLS(1,1),cells(endcolumn,endrow)).select
(endcolumn,endrow,最右行號與最下列號)
然后:
ActiveWindow.Zoom = True
(以選定範圍顯示)
再來
range("a1").select

没牙兔兔

天啦，兔兔对ADAM佩服的真实五体投地
敬仰之情，犹如滔滔江水连绵不绝，嘻嘻
有空到深圳去的话，一定请你搓一顿

呵呵，对于excel和access的交互以及access的技巧编程，从你这儿学到了不少东西，真诚表示感谢！！！

大頭

好文章
這個我學不來

没牙兔兔

呵呵，还是学一下也有用
Excel我原来编程也是从来不使用的
这次任务逼得我赶鸭子上架，呵呵，如果不用excel模版的话
报表就只能自己画，累死兔兔啦


嘻嘻，使用excel，兔兔基于报表设计，打印的灵活性设置等方面都偷懒啦

ADAM

不要這么說我,我也只會那么一點點...
我是從EXCEL上手的..
呵呵...

pigeon

若建立了EXCEL模板后，打印报表时若数据变了，怎样把更改后的数据写入EXCEL模板中去？有例子更好。

没牙兔兔

兔兔这儿excel模板的数据为空,不是采用excel链接数据库的方式
使用方法:
引用excel对象,然后逐行把access数据写入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
'定义excel对象,需要在引用 中加入excel对象
  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

  '这儿兔兔实现的不好,有点笨   主要实现的功能是通过模板文件生成相应格式的excel文件用来写入数据,并保证每次按下导出按钮生成的excel文件都是新的
  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
            tmpFileName = IIf(InStrRev(Me.dlgCommon.FileName, "\") > 0, Right(Me.dlgCommon.FileName, Len(Me.dlgCommon.FileName) - k), Me.dlgCommon.FileName)
            
            If tmpFileName <> "建制单位综合统计表.xls" Then
                MsgBox "模板文件丢失或选择错误，你不能导出数据！"
                Exit Sub
            End If
      
  End If
  
  
'不要生成一大堆excel对象占内存
  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
'从第4行开始计数,前三行已经是模板固定的表头啦
     Row = 4
    While Not Rs.EOF
          .Cells(Row, 1) = Rs("sname")
     
   
         '将字段的内容赋值给相应表格,这儿主要是一些小计,合计的字段,我没有用access实现,是在excel中设置的合计cell,所以填入数据的时候应该跳过这些格子
        For i = 0 + 5 To Rs.Fields.Count - 1
            Select Case i
                Case 5
                     Col = 3
                Case 6, 33
                     Col = Col + 3
                Case 10, 15, 16, 19, 23, 35, 45, 48, 51, 54, 57, 65, 67
                     Col = Col + 2
                Case Else
                    Col = Col + 1
            End Select
            '填入所有相关的值,如果为0的话,就不填啦
            If Rs.Fields(i) > 0

pigeon

写得这么详细，谢谢兔兔了！我先试试看。