Access交流中心

北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |

回复 加入收藏帖  复制
我要提问 帖子上移

[5分]设置一个导出窗体明细导出execl表后,超过模版规定的行数后自动换页,如何在导出代码中写!

凌云 等级: 一星会员▲ 积分:181 金币:280 来自:广州Access交流中心 发表于:2013-08-23 13:29:15   已结帖
楼主

我现在设置的模版只有15号,如果超过15行后,数据会填下在下面的空白处,致使我明细下面的备注全部被占领,有什么办法能让它规定的模版的行数后会自动换页填写!请高手指点。下面为导出明细窗体的代码。

Private Sub Command78_Click()

    Dim strTemplate As String           '模板文件路径名
    Dim strPathName As String           '输出文件路径名
    Dim objApp As Object      'Excel程序
    Dim objBook As Object       'Excel工作簿
    Dim rst As Object   '子窗体记录集
    Dim intN As Integer   '循环计数器
    Dim blnNoQuit As Boolean        '此标记为True时不关闭Excel
    Dim fx As String
    Dim tel As String
'    tel = DLookup("电话", "供应商", "供应商编号='" & Me.供应商编号 & "'")
'    fx = DLookup("备注", "供应商", "收货单位='" & Me.供应商 & "'")
'当前是新记录则提示并退出
    If Me.NewRecord Then
        MsgBox "当前没有数据可导出!", vbExclamation, "提示"
        Exit Sub
    End If


    '模板文件路径
    strTemplate = CurrentProject.Path & "\report\网络配送委托单模版.xlt"


    '通过文件对话框取得另存为文件名
    With FileDialog(2)    'msoFileDialogSaveAs
        .InitialFileName = CurrentProject.Path & "\stmp\网络委托书 " & _
                           Me.托运出库编号 & ".xls"
        If .Show Then strPathName = .SelectedItems(1)
    End With
    '对话框被取消则退出过程
    If strPathName = "" Then Exit Sub
    '如果文件名后没有.xls扩展名则加上
    If Not strPathName Like "*.xls" Then strPathName = strPathName & ".xls"
    '如果文件已存在,先删除已有文件
    If Dir(strPathName) <> "" Then Kill strPathName


    '设置鼠标指针为沙漏形状
    DoCmd.Hourglass True
    '创建Excel对象
    Set objApp = CreateObject("Excel.Application")
    '打开模板文件
    Set objBook = objApp.Workbooks.Open(strTemplate)
    objBook.Sheets("Sheet1").Select
    With objApp
        '根据主窗体记录写入订单表头
        .Range("B3") = Me.收货单位
        .Range("H3") = Me.出库日期
        .Range("H4") = Me.供应商
        .Range("K3") = Me.配送单号
        .Range("F24") = Me.件数
        .Range("H24") = Me.重量
        '        .Range("B23") = Me.出库日期


        Set rst = Me.sfrDetail.Form.Recordset
        If rst.RecordCount > 0 Then rst.MoveFirst
        intN = 5
        Do Until rst.EOF
            intN = intN + 1
            '写入订单明细
            .Range("B" & intN) = rst!货物名称
            .Range("C" & intN) = rst!件数
            .Range("D" & intN) = rst!目的地
            .Range("E" & intN) = rst!收货单位
            .Range("F" & intN) = rst!收货人
            .Range("G" & intN) = rst!收货电话
            .Range("H" & intN) = rst!收货地址
            .Range("J" & intN) = rst!计费体积
            .Range("K" & intN) = rst!计费重量
            rst.MoveNext
        Loop
        '由于明细数据的行数不固定,这里通过在模板中设置好第一行的格式
        '第一行明细以后就在这里直接复制第一行的格式就行了
        .Range("A4", "L18").Copy
        .Range("A4", "L" & intN).PasteSpecial -4122  'xlPasteFormats
        '在订单明细最后写入总计
        '        .Range("C" & intN + 1) = "件数总计:"
        '        .Range("D" & intN + 1).Formula = "=SUM(D4:D" & intN & ")"
        '        .Range("D" & intN + 1).Select

 End With
    '保存Excel文件,因为模板是不能修改的,所以是另存为
    objBook.SaveAs strPathName
    DoCmd.Hourglass False
    Beep
    If MsgBox("导出已完成,是否打开导出的Excel文件?", vbQuestion + vbYesNo, "导出完成") = vbYes Then
        objApp.Visible = True
        objBook.Saved = True
        blnNoQuit = True
        '自动进入打印预览
        objApp.ActiveWindow.SelectedSheets.PrintPreview
    End If


End Sub

 

access培训  诚聘access开发人员

    凌云
      获得社区协助:请教问题(即发帖)62篇,其中获得解决的58篇;
      协助社区成员:协助他人(即回帖)53篇,其中被设为【最佳答案】的9篇;
      协助我们社区:发布技术文章7篇,邀请了0名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
Top

扫描下方工作人员的微信二维码加微信,邀您加入Access课堂微信群,进入一个技术交际圈:

网站工作人员微信

cspa 等级:贵宾★★★★★ 积分:723 金币:400 来自:北京Access交流中心 发表于2013/8/24 22:52:34 
1楼 得分: 0


    很高兴与您就本帖子进行交流,如果我的回答已经解决了您的问题,请点击上方的“最佳答案”,这样本帖子就不会在“待解决问题区”显示了,我也将获得2个积分奖励,并不会减少您的积分!
    cspa
      获得社区协助:请教问题(即发帖)21篇,其中获得解决的13篇;
      协助社区成员:协助他人(即回帖)808篇,其中被设为【最佳答案】的255篇;
      协助我们社区:发布技术文章10篇,邀请了0名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
cspa 等级:贵宾★★★★★ 积分:723 金币:400 来自:北京Access交流中心 发表于2013/8/26 16:39:51 
2楼 得分: 0
为什么看不见我的回复呢?

    很高兴与您就本帖子进行交流,如果我的回答已经解决了您的问题,请点击上方的“最佳答案”,这样本帖子就不会在“待解决问题区”显示了,我也将获得2个积分奖励,并不会减少您的积分!
    cspa
      获得社区协助:请教问题(即发帖)21篇,其中获得解决的13篇;
      协助社区成员:协助他人(即回帖)808篇,其中被设为【最佳答案】的255篇;
      协助我们社区:发布技术文章10篇,邀请了0名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
cspa 等级:贵宾★★★★★ 积分:723 金币:400 来自:北京Access交流中心 发表于2013/8/26 16:47:02 
3楼 得分: 0


    很高兴与您就本帖子进行交流,如果我的回答已经解决了您的问题,请点击上方的“最佳答案”,这样本帖子就不会在“待解决问题区”显示了,我也将获得2个积分奖励,并不会减少您的积分!
    cspa
      获得社区协助:请教问题(即发帖)21篇,其中获得解决的13篇;
      协助社区成员:协助他人(即回帖)808篇,其中被设为【最佳答案】的255篇;
      协助我们社区:发布技术文章10篇,邀请了0名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
cspa 等级:贵宾★★★★★ 积分:723 金币:400 来自:北京Access交流中心 发表于2013/8/26 16:51:39 
4楼 得分: 0

艾服了you,这个帖子有问题,贴上代码就显示不出来。

管理员,报错了。



    很高兴与您就本帖子进行交流,如果我的回答已经解决了您的问题,请点击上方的“最佳答案”,这样本帖子就不会在“待解决问题区”显示了,我也将获得2个积分奖励,并不会减少您的积分!
    cspa
      获得社区协助:请教问题(即发帖)21篇,其中获得解决的13篇;
      协助社区成员:协助他人(即回帖)808篇,其中被设为【最佳答案】的255篇;
      协助我们社区:发布技术文章10篇,邀请了0名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
凌云 等级:一星会员▲ 积分:181 金币:280 来自:广州Access交流中心 发表于2013/8/26 19:33:36 
5楼 得分: 0
是啊,就是看不到你的回复内容!

    凌云
      获得社区协助:请教问题(即发帖)62篇,其中获得解决的58篇;
      协助社区成员:协助他人(即回帖)53篇,其中被设为【最佳答案】的9篇;
      协助我们社区:发布技术文章7篇,邀请了0名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
cspa 等级:贵宾★★★★★ 积分:723 金币:400 来自:北京Access交流中心 发表于2013/8/27 20:15:04 最佳答案
6楼 得分: 5

已将做好后的文件发到你QQ。

1,我用的是2003,打𣎴开你的非2003文件,也打不开你带密码的数据库文件。好在打开了你的excel模板文件

2,于是我做了些试验用数据,把程序调试出来了,至少用我的数据运行是正常的

3,切记,在用程序之前要先把你的excel模板文件修改一下,删除其中的Sheet2和Sheet3,仅保留Sheet1。



    很高兴与您就本帖子进行交流,如果我的回答已经解决了您的问题,请点击上方的“最佳答案”,这样本帖子就不会在“待解决问题区”显示了,我也将获得2个积分奖励,并不会减少您的积分!
    cspa
      获得社区协助:请教问题(即发帖)21篇,其中获得解决的13篇;
      协助社区成员:协助他人(即回帖)808篇,其中被设为【最佳答案】的255篇;
      协助我们社区:发布技术文章10篇,邀请了0名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
王三平 等级:一星会员▲ 积分:476 金币:2560 来自:秦皇岛Access交流中心 发表于2013/8/28 13:40:52 
7楼 得分: 0

其实没有必要做换页处理。你重新设置下你的EXCEL模板就可以了。

你不就想打印时,明细超过一页时,顶端标题行没有出现对吧。

EXCEL的页面设置

顶端标题行中注上你要显示的标题行就可以了。



    很高兴与您就本帖子进行交流,如果我的回答已经解决了您的问题,请点击上方的“最佳答案”,这样本帖子就不会在“待解决问题区”显示了,我也将获得2个积分奖励,并不会减少您的积分!
    王三平
      获得社区协助:请教问题(即发帖)51篇,其中获得解决的48篇;
      协助社区成员:协助他人(即回帖)42篇,其中被设为【最佳答案】的11篇;
      协助我们社区:发布技术文章64篇,邀请了50名新会员注册本社区(如何邀请会员注册,详见:http://www.accessoft.com/sitehelp.asp)。
总记录:7篇  页次:1/1 9 1 :
您还没有在Access软件网登录不能回复帖子
  • 你没有登录,请点击后面链接登录:登录
  • 如果你没有注册,请点击后面链接注册:注册,注册完成后,请再次访问本页功能。