Access专家课堂周年庆
网站公告
·Access快速平台QQ群号:277422564    ·Access快速开发平台下载地址及教程    ·欢迎添加微信交流账号:AccessoftChu    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access开发平台

Access快速开发平台辅助导出函数

时 间:2019-04-06 20:32:21
作 者:丘苏洲   ID:66601  城市:普宁
摘 要:快速开发平台辅助导出函数
正 文:

      这几天用到平台的导出函数,功能比较强大,但是对于组合框导出的结果不是很理想。希望导出的是显示的列而不是绑定列数据,是/否字段是否=-1有时也会显示为#####错误。

时间已在论坛找到方法:格式设置为“H:NN”用平台导出函数不会出错。

组合框没有合适的方法,所以写了一个自定义函数来导出组合框第二列内容并把是/否改为“T”/“F”文本型数值。

*平台导出函数是直接新建一个EXCEL进程, Set EXLapp = GetObject(, "excel.application")只能获取第一个打开的EXCEL进行所有工作簿记。

*每次使用辅助格式化函数,必需关闭所有已打开的EXCEL,辅助格式化函数才可以正常运行。

以也为导出后效果:


自定义函数需要引用EXCEL


时间字段格式改为“H:NN”


自定义函数通过标签来判断需要格式化字段,“”是组合框,“”为是/否字段


平台自动生成的“导出”代码改为以下

Public Sub btnExport_Click()
    Dim ExportName As String
    If Not Me.sfrList.Form.CurrentRecord > 0 Then Exit Sub
    Set gsfrList = Me.sfrList
    ExportName = ExportToExcel(DataForm:=Me.sfrList)
    If ExportName <> "" Then formatExport ExportName
End Sub


以下为自定义格式化源码:

Function formatExport(ExportName As String)
 On Error GoTo ErrorHandler
    Dim i As Long
    Dim J As Integer
    Dim Namej(50, 6)
    Dim ctl As Control
    Dim rowi As Long
    Dim EXLapp As Excel.Application
    Dim EXLwork As Excel.Workbook
    Dim EXLSheet As Excel.Worksheet
    Set EXLapp = GetObject(, "excel.application")
    Set EXLwork = EXLapp.Workbooks(ExportName)
    Set EXLSheet = EXLwork.Worksheets("Sheet1")
    EXLapp.Visible = False
    '历遍所有控件,找到带有格式化标签的字段内容保存到数组.
    '是组合框需要用第二列更新,是/否字段更新为"T"/"F".
    
    J = 0
    For Each ctl In gsfrList.Form.Controls
        If ctl.Tag = "" or ctl.Tag = "" Then
            Namej(J, 0) = ctl.Name
            Namej(J, 1) = ctl.Tag
            Namej(J, 2) = J
            Namej(J, 3) = ctl.Controls(0).Caption
            Namej(J, 4) = 0
            Namej(J, 5) = "F"
            J = J + 1
        End If
    Next


    '历遍EXCEL第一行,和数组标题内容对比保存需格式化字段在EXCEL的对应列.
    J = 1
    With EXLSheet
    Do While Not (.Cells(1, J) = "")
        For i = 0 To 49
            If .Cells(1, J) = Namej(i, 3) Then Namej(i, 4) = J: Exit For
        Next i
        J = J + 1
    Loop
        '定义进度条
    Dim clsPB As PopupProgressBar
    Set clsPB = CreateInstance("PopupProgressBar")
    clsPB.StatusText = LoadString("Format Excel...")
    clsPB.PercentFormat = "0%"
    clsPB.Max = gsfrList.Form.Recordset.RecordCount
    '历遍列表窗数据,更新EXCEL需要格式化数据.
    rowi = 0
    gsfrList.Form.Recordset.MoveFirst
    For i = 1 To gsfrList.Form.Recordset.RecordCount
    rowi = rowi + 1
    clsPB.Value = rowi
        For J = 0 To 49
            If Namej(J, 0) = "" Then Exit For
            If Namej(J, 4) <> 0 Then
                Select Case Namej(J, 1)
                Case ""  '用组合框第二列更新EXCEL
                    .Cells(i + 1, Namej(J, 4)) = Nz(gsfrList.Form.Controls(Namej(J, 0)).Column(1), "")
                    If Namej(J, 5) = "F" Then
                    .Columns(Namej(J, 4)).EntireColumn.AutoFit
                    Namej(J, 5) = "T"
                    End If
                Case ""  '是/否字段 用"T"/"F"更新EXCEL ACCESS  true导出是-1在EXCEL有时显示不正确.
                    If gsfrList.Form.Controls(Namej(J, 0)) <> 0 Then
                        .Cells(i + 1, Namej(J, 4)) = "T"
                    Else
                        .Cells(i + 1, Namej(J, 4)) = "F"
                    End If
            End Select
                End If
            
        Next J
        
        gsfrList.Form.Recordset.MoveNext
    Next i
    End With
ExitHere:
    Set clsPB = Nothing
    EXLapp.Visible = True
    Set EXLapp = Nothing
    Set EXLwork = Nothing
    Set EXLSheet = Nothing
    Exit Function


ErrorHandler:
    RDPErrorHandler LoadString("Close Excel and rerun Export Excel.")
    Resume ExitHere
End Function



Access快速开发平台QQ群 (群号:239158550)       access源码网店

最新评论 查看更多评论(2)

2019/5/29 10:42:01一念一如来
对组合框的试了没显现效果,不知我哪里没做对? 在组合框的标签里输了<DC>,没显灵 然后,在自定义函数代码里改成如下,还没显灵 For Each ctl In gsfrList.Form.Controls If ctl.Tag = "DC" or ctl.Tag = "TF" Then Namej(J, 0) = ctl.Name 我便再没咒语了……

2019/4/8 13:10:23同学
都是牛人

发表评论您的评论将提升作者分享的动力!快来评论一下吧!

用户名:
密 码:
内 容:
 

常见问答

技术分类

相关资源

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助