При вставке данных и рисунка из Access to Excel автоматизация завершается неудачей при втором запуске кода

#excel #vba #ms-access

Вопрос:

Я работаю с небольшим офисным инструментом ms-access. Один из отчетов экспортирует данные в шаблон Excel. это работает нормально. Я решил, что мне нужно добавить картинку во второй из листов рабочей книги. Приведенный ниже код работает один раз, но когда я закрываю приложение Excel и пытаюсь во второй раз, я получаю «1004: Метод ‘Worksheets’ объекта ‘_Application’ не удался. Я попытался исправить, используя справочную статью MS 178510, в которой объясняется важность того, чтобы каждый вызов объекта, метода или свойства Excel определялся соответствующей объектной переменной. Ниже приведен мой код. Я новичок в этом и мог бы оценить любую помощь.

 Private Sub btnOpReport2_Click()

On Error GoTo Error

Dim myPict As Excel.Picture
Dim rst
Dim XL As Excel.Application
Dim xlWS As Excel.Worksheet
Dim vFile

Set XL = CreateObject("excel.application")

vFile = TempVars("BackPath") amp; "Templates" amp; "Operation.xltx"

DoCmd.SetWarnings False
    DoCmd.OpenQuery ("qry_Ops_to_OAIs")
    Set rst = CurrentDb.OpenRecordset("tbl_TEMP_OPS_to_OAIs")

With XL
   .Visible = True
   .Workbooks.Open vFile
   .Sheets("Data").Select
   .Range("A2").Select
   .ActiveCell.CopyFromRecordset rst
   .ActiveWorkbook.Sheets("Data").Visible = xlSheetHidden


    Set xlWS = Excel.Application.Worksheets("Operation")

    xlWS.Activate

        With xlWS.Range("N8")
            Set myPict = .Parent.Pictures.Insert(TempVars("BackPath") amp; "Activity_Documents" amp; Me.GraphicLink)
            myPict.Top = .Top
            myPict.Left = .Left
            myPict.Height = 470
            myPict.Width = 500
            myPict.Placement = xlMoveAndSize
        End With

End With


Set rst = Nothing
Set XL = Nothing
Set vFile = Nothing
Set myPict = Nothing
Set xlWS = Nothing
  
DoCmd.DeleteObject acTable, "tbl_TEMP_OPS_to_OAIs"
DoCmd.SetWarnings True

ExitError:
    Exit Sub
    
Error:
    MsgBox Err.Number amp; ": " amp; Err.Description
    Resume ExitError
End Sub

1. Не так уж плохо для новичка, но для настройки рабочего листа вы используете неправильные свойства Excel. Приложение. Ошибка Worksheets неявно Excel.Application.ActiveWorkbook.Worksheets также указывает на то, что метод Worksheets of Application потерпел неудачу. Возможно, ActiveWorkbook это не тот, который содержит метод .Worksheets("Operation") сохранения ссылки на workbook on .Open , который возвращает ссылку, просто нужно сохранить его!

2. Спасибо. Есть ли у вас предпочтительная ссылка для изучения VBA для Access, чтобы я мог немного улучшить это?

Ответ №1:

Вы подключились .Sheets("Data").Select к Application объекту через свой With блок: было бы лучше получить явную ссылку на открытую книгу и использовать ее вместо этого.

Попробуйте это — если у него все еще есть проблемы, закомментируйте On Error и посмотрите, в какой строке проблема

 Private Sub btnOpReport2_Click()

    On Error GoTo haveError    ' "Error" as a line label is a bit confusing maybe...
    
    Dim myPict As Excel.Picture
    Dim rst
    Dim XL As Excel.Application
    Dim xlWb As Excel.Workbook   '<<<<<
    Dim vFile
    
    Set XL = CreateObject("excel.application")
    
    vFile = TempVars("BackPath") amp; "Templates" amp; "Operation.xltx"
    
    DoCmd.SetWarnings False
    DoCmd.OpenQuery ("qry_Ops_to_OAIs")
    Set rst = CurrentDb.OpenRecordset("tbl_TEMP_OPS_to_OAIs")

    XL.Visible = True
    Set xlWb = XL.Workbooks.Open(vFile) '<< get a reference to the opened file
   
    With xlWb.Worksheets("Data")
        .Range("A2").CopyFromRecordset rst
        .Visible = xlSheetHidden
    End With
    
    With xlWb.Worksheets("Operation").Range("N8")
        Set myPict = .Parent.Pictures.Insert(TempVars("BackPath") amp; _
                                "Activity_Documents" amp; Me.GraphicLink)
        myPict.Top = .Top
        myPict.Left = .Left
        myPict.Height = 470
        myPict.Width = 500
        myPict.Placement = xlMoveAndSize
    End With

    DoCmd.DeleteObject acTable, "tbl_TEMP_OPS_to_OAIs"
    DoCmd.SetWarnings True
    
ExitError:
        Exit Sub
        
haveError:
        MsgBox Err.Number amp; ": " amp; Err.Description
        Resume ExitError

End Sub

1. Попробуйте это , как правило, здесь не считается ответом. Было бы лучшим ответом, если бы вы объяснили различия в вашем коде и почему эти различия являются решением проблемы.

2. Это сработало отлично @Tim Williams!!!! Спасибо!!