Question

我知道这已被多次提出（通常在运行时错误'1004'下）但我在我的代码中隔离错误时遇到了困难 - 尽管在这里和其他网站都进行了广泛的研究。我的代码从Access窗体上的命令按钮运行，并在打开表单后第一次成功运行，但在后续尝试时失败。我认为我使用不充分的引用和/或打开第二个Excel对象，但我无法弄清楚如何。其他格式化已经执行，但我已尽可能地删除它以保持简短。

Private Sub cmdExport_Click（）

Dim dbs As Database
Dim rst As DAO.Recordset
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim lngCount As Long
Dim lngDataRows As Long
Dim intLoop As Integer
Dim strSheetName As String
Dim dteStart As Date
Dim dteEnd As Date
Dim curStartBal As Currency
Dim intMoves As Integer
Dim lngCol As Long
Dim lngRow As Long
Dim intField As Integer
Dim intFieldCount As Integer
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim blnFileCheck As Boolean

strFile = "BudgetForecast.xlsx"
strPath = genFindFolder("tblSettings")  'provides path to data store
strPathFile = strPath & strFile

blnFileCheck = genDeleteFile(strPath, strFile) 'Deletes existing file if it exists

dteStart = DateAdd("m", 1, Date)
dteEnd = DateAdd("m", 12, Date)
strSheetName = "Forecast " & MonthName(Month(dteStart), True) & " " & CStr(Year(dteStart))         'Start Month and Year
strSheetName = strSheetName & " To " & MonthName(Month(dteEnd), True) & " " & CStr(Year(dteEnd))   'Add End Month and Year
curStartBal = [Forms]![frmBudForecast]![txtStart1]

'Create new Excel Workbook and add data
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qryBudForecastFinal")
Set appExcel = New Excel.Application
Set wbk = appExcel.Workbooks.Add
Set wks = wbk.ActiveSheet

appExcel.Visible = True

With wks
    .Name = strSheetName
    .Cells(1, 1).Value = "Sort"
    .Cells(1, 2).Value = "Date"
    .Cells(1, 3).Value = "Type"
    .Cells(1, 4).Value = "Account"
    .Cells(1, 5).Value = "Payee/Details"
    .Cells(1, 6).Value = "Jan"
        ' lines for Feb to Nov removed to shorten extract
    .Cells(1, 17).Value = "Dec"
    .Cells(1, 18).Value = "Totals"

    rst.MoveLast
    rst.MoveFirst
    lngCount = rst.RecordCount
    intFieldCount = rst.Fields.Count
    lngDataRows = lngCount + 5

    rst.MoveFirst
    Do Until rst.EOF
        lngCol = 1
        lngRow = .[A65536].End(3).Row + 1
        For intField = 0 To intFieldCount - 1
            .Cells(lngRow, lngCol) = rst.Fields(intField).Value
            lngCol = lngCol + 1
        Next intField
        rst.MoveNext
    Loop

    'Shift columns around to correct order
    If Month(Date) <> 12 Then   'If December, records are already in correct order
        intMoves = Month(Date)
        For intLoop = 1 To intMoves
            .Columns("R:R").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove '###Error here
            .Columns("F:F").Select
                Selection.Cut Destination:=Columns("R:R")
            .Columns("F:F").Select
                Selection.Delete Shift:=xlToLeft
        Next intLoop
    End If

End With

'Save new file (next line commented-out for testing)
'appExcel.ActiveWorkbook.SaveAs FileName:=strPathFile, ConflictResolution:=xlOtherSessionChanges
'Close Excel
appExcel.ActiveWindow.Close (False)

'Cleanup
rst.Close
Set rst = Nothing
Set dbs = Nothing
Set wks = Nothing
Set wbk = Nothing
appExcel.Quit   'Not sure if this line is necessary
Set appExcel = Nothing

End Sub

此行发生错误：

Selection.Insert Shift：= xlToRight，CopyOrigin：= xlFormatFromLeftOrAbove

和'选择'似乎是'没什么'。

我已经尝试了各种各样的变体和修改语法 - 我怀疑我需要更具体地选择列R，但我不知道如何。顺便提一下，当代码失败时，选择电子表格上的列R 。我很想在点击它之后隐藏表格上的命令按钮，但担心这会是一个警察，当然不会帮助我理解。

Answer 1

post_max_size = 64M
upload_max_filesize = 64M

appExcel.Selection不是Access对象模型的一部分。但是你应该尽量避免使用select / activate。例如：

Selection

最好写成：

.Columns("F:F").Select
Selection.Delete Shift:=xlToLeft

https://drive.google.com/open?id=1wxWmFawOYfOTYz3e7Vl0MoHUsOFPBY1A

使用Excel时访问运行时错误“91”

1 个答案: