将窗体中的数据写入工作表编辑区-杨雪
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


将窗体中的数据写入工作表编辑区

发表时间:2016/8/28 9:04:35 评论(1) 浏览(9251)  评论 | 加入收藏 | 复制
   
摘 要:    在导出一条记录时,导出一个字段的数据需要跳转至下一个单元格。在工作表中以单元格为基础进行跳转,可以使用Offset 方法实现:
正 文:
示例下载

 

       在导出一条记录时,导出一个字段的数据需要跳转至下一个单元格。在工作表中以单元格为基础进行跳转,可以使用Offset 方法实现:

               [基础单元格].offset([跳转行数],[跳转列数])

 

源码:

Private Sub Command1_Click()
On Error GoTo 创建
    Dim xlApp As Object    'Excel.Application
    Dim xlWbk As Object    'Excel.Workbook
    Dim xlWsh As Object    'Excel.Worksheet
    Dim Rng1  As Object    'Excel.Range
    Dim Rng   As Object    'Excel.Range
    Dim rsNum As Integer
    Dim i As Integer
    Dim db As Database
    Dim rs As Recordset
    '激活指定工作表
    Set xlApp = GetObject(, "excel.application")
    xlApp.Visible = True
    Set xlWbk = xlApp.Workbooks.Open(CurrentProject.Path & "\示例工作簿.xlsx")
    Set xlWsh = xlWbk.Worksheets("sheet4")
    xlWsh.Activate
    '统计当前窗体中的记录数目
    rsNum = DCount("书籍编号", "存书查询")
    '将字段名称导出到Excel表格中作表头
    xlWsh.Range("A1").Value = Me.Label2.Caption
    xlWsh.Range("B1").Value = Me.Label3.Caption
    xlWsh.Range("c1").Value = Me.Label4.Caption
    xlWsh.Range("D1").Value = Me.Label5.Caption
    xlWsh.Range("E1").Value = Me.Label6.Caption
    xlWsh.Range("F1").Value = Me.Label7.Caption
    xlWsh.Range("G1").Value = Me.Label8.Caption
    'Excel表格定位至A2单元格
    Set Rng = xlWsh.Range("A2")

    '窗体中的记录定位至第一条记录
    DoCmd.GoToRecord , , acFirst
    '逐条导出窗体中的记录
    For i = 1 To rsNum
        Rng.Value = Me.书籍编号
        '导出一个数据之后跳转至表格的同一行下一列
        Set Rng = Rng.Offset(0, 1)
        Rng.Value = Me.书名
        Set Rng = Rng.Offset(0, 1)
        Rng.Value = Me.类别ID
        Set Rng = Rng.Offset(0, 1)
        Rng.Value = Me.作者
        Set Rng = Rng.Offset(0, 1)
        Rng.Value = Me.出版社ID
        Set Rng = Rng.Offset(0, 1)
        Rng.Value = Me.单价
        Set Rng = Rng.Offset(0, 1)
        Rng.Value = Format(Me.进书日期, "yyyy/mm/dd")
        '一条记录导出完之后,跳转至下一行第一列
        Set Rng = Rng.Offset(1, -6)
        DoCmd.GoToRecord acActiveDataObject, , acNext
    Next i
    '另存导出的Excel工作簿
    xlWbk.SaveAs CurrentProject.Path & "\存书查询" & Int(Rnd * 1000) & ".xlsx"

创建:
    If Err = 429 Then
        Set xlApp = CreateObject("excel.application")
        Resume Next
    End If

End Sub

 

 


Access软件网交流QQ群(群号:198465573)
 
 相关文章
【access源码示例】导入导出系列——Excel固定格式导出(插...  【红尘如烟  2011/3/12】
【access源码示例】导入导出系列--Excel固定格式的订单数...  【红尘如烟  2011/4/1】
【Access小品】快速导入多个相同结构Excel表数据示例  【煮江品茶  2014/11/21】
常见问答
技术分类
相关资源
文章搜索
关于作者

杨雪

文章分类

文章存档

友情链接