Access快速开发平台--Error#1004 Function ExportToExcel2()不能设置类Window的FreezePanes属性的解决方法-麥田
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access开发平台


Access快速开发平台--Error#1004 Function ExportToExcel2()不能设置类Window的FreezePanes属性的解决方法

发表时间:2017/11/25 0:03:23 评论(1) 浏览(8916)  评论 | 加入收藏 | 复制
   
摘 要:Access快速开发平台--Error#1004 Function ExportToExcel2()不能设置类Window的FreezePanes属性的解决方法
正 文:

在操作Access快速开发平台导出到Excel数据表会出现错误:
Error#1004 Function ExportToExcel2()不能设置类Window的FreezePanes属性,如下图:
点击图片查看大图

 

解决方法:
在Main数据库里面新建一个模块,将下列代码贴在模块里面保存即可,再操作导出Excel即可解决。

 

Function ExportToExcel2(Optional WorkbookName As String, _
                        Optional WorksheetName As String, _
                        Optional StartRange As String = "A1", _
                        Optional DataForm As Form, _
                        Optional DisplayAfterExporting As Boolean = True _
                        ) As String
    On Error GoTo ErrorHandler

    Const xlWorkbookNormal = -4143
   
    With Application.FileDialog(msoFileDialogSaveAs)
        Dim strFileName As String: strFileName = WorkbookName
        If strFileName = "" Then strFileName = DataForm.Caption
        If strFileName = "" Then strFileName = "Book1"
        If Not strFileName Like "*" & IIf(Val(Application.Version) > 11, ".xlsx", ".xls") Then
            strFileName = strFileName & IIf(Val(Application.Version) > 11, ".xlsx", ".xls")
        End If
        .InitialFileName = strFileName
        strFileName = ""
        If Not .Show Then Exit Function
        strFileName = .SelectedItems(1)
    End With

    If Dir(strFileName) <> "" Then Kill strFileName

    DoCmd.Hourglass True
   
    If DataForm Is Nothing Then
        Set DataForm = Screen.ActiveControl.Form
    End If
    DataForm.repaint
    DataForm.Painting = False

    Dim clsPB As PopupProgressBar: Set clsPB = CreateInstance("PopupProgressBar")
    clsPB.StatusText = LoadString("Exporting...")
    If DataForm.Recordset.RecordCount > 0 Then
        DataForm.Recordset.MoveLast
        DataForm.Recordset.MoveFirst
    End If
    clsPB.Max = DataForm.Recordset.RecordCount
   
    Dim objApp   As Object: Set objApp = CreateObject("Excel.Application")
    Dim objBook  As Object: Set objBook = objApp.Workbooks.Add()
    Dim objSheet As Object: Set objSheet = objBook.Worksheets(1)
'    objApp.Visible = True
   
    Do Until objBook.Worksheets.Count = 1
        objBook.Worksheets(2).Delete
    Loop
    Set objSheet = objBook.Worksheets(1)
    objSheet.select
    Dim strSheetName As String: strSheetName = WorksheetName
    If strSheetName <> "" Then
        strSheetName = Replace(strSheetName, "/", "")
        strSheetName = Replace(strSheetName, "\", "")
        strSheetName = Replace(strSheetName, "?", "")
        strSheetName = Replace(strSheetName, "*", "")
        strSheetName = Replace(strSheetName, "[", "")
        strSheetName = Replace(strSheetName, "]", "")
        objSheet.Name = Left(strSheetName, 30)
    End If
   
    Dim varFieldList As Variant: varFieldList = GetFormFieldList(DataForm)
    Dim lngCol As Long: lngCol = 1

    On Error Resume Next
    Dim varItem As Variant
    For Each varItem In varFieldList
        objSheet.Cells(1, lngCol).Value = DataForm("" & varItem).Controls(0).Caption
        Dim strFormat As String: strFormat = DataForm("" & varItem).Format
        Select Case True
        Case strFormat Like "*:nn:*": strFormat = Replace(strFormat, ":nn:", ":mm:")
        Case strFormat Like "*:n:*":  strFormat = Replace(strFormat, ":n:", ":m:")
        End Select
        objSheet.Columns(lngCol).NumberFormatLocal = strFormat
       
        If (TypeOf DataForm("" & varItem) Is TextBox) _
        or (TypeOf DataForm("" & varItem) Is ComboBox) _
        or (TypeOf DataForm("" & varItem) Is ListBox) Then
            Select Case DataForm("" & varItem).TextAlign
            Case 1: objSheet.Columns(lngCol).HorizontalAlignment = xlLeft
            Case 2: objSheet.Columns(lngCol).HorizontalAlignment = xlCenter
            Case 3: objSheet.Columns(lngCol).HorizontalAlignment = xlRight
            End Select
            objSheet.Columns(lngCol).VerticalAlignment = xlCenter
        End If
        lngCol = lngCol + 1
    Next
    On Error GoTo ErrorHandler

    Dim lngRow As Long: lngRow = 2
    Dim rst As Object: Set rst = DataForm.Recordset
    Do Until rst.EOF
        lngCol = 1
        For Each varItem In varFieldList
            objSheet.Cells(lngRow, lngCol).Value = DataForm("" & varItem)
            lngCol = lngCol + 1
        Next
        lngRow = lngRow + 1
        clsPB.Value = lngRow
        rst.MoveNext
    Loop
    FormatExcelSheet objSheet

    objApp.DisplayAlerts = False
    If Val(Application.Version) > 11 Then
        objBook.SaveAs strFileName, xlOpenXMLWorkbook
    Else
        objBook.SaveAs strFileName, xlWorkbookNormal
    End If
    objApp.DisplayAlerts = True
    strFileName = objBook.Name
    clsPB.CloseProgressBar
'    objApp.Workbooks.Open FileName:=strFileName
    If DisplayAfterExporting Then
        objApp.Visible = True
    Else
        objBook.Close
        objApp.Quit
    End If
    ExportToExcel2 = strFileName

ExitHere:
    DoCmd.Hourglass False
    DataForm.Painting = True
    Set clsPB = Nothing
    Set objSheet = Nothing
    Set objBook = Nothing
    Set objApp = Nothing
    Set rst = Nothing
    Exit Function

ErrorHandler:
    MsgBox "Function ExportToExcel2()" & vbCrLf & Err.Description, vbCritical, "Error #" & Err.Number
    Resume ExitHere
End Function


Access软件网交流QQ群(群号:198465573)
 
 相关文章
VBA运行时错误1004的解决方法\运行时错误'1004':方法'...  【麥田  2012/8/1】
快速开发平台--#429 ExportToExcel() Acti...  【麥田  2013/6/21】
Access快速开发平台--导出Excel文件出现#1004 Ex...  【麥田  2014/8/21】
2.0.2版本快速开发平台“导出”出错,错误号#1004解决办法  【盘龙云海  2014/11/2】
快速开发平台--解决导出EXCEL错误/错误#1004-类Work...  【风行  2014/11/29】
快速开发平台--导出Excel出现:Function Export...  【麥田  2014/12/29】
常见问答
技术分类
相关资源
文章搜索
关于作者

麥田

文章分类

文章存档

友情链接