这几天用到平台的导出函数,功能比较强大,但是对于组合框导出的结果不是很理想。希望导出的是显示的列而不是绑定列数据,是/否字段是否=-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