Передача данных в Excel

Question

У меня есть следующий код для передачи кода в Excel файл:

Dim SaveAsStr As String 
    Dim appXL As Excel.Application 
    Dim wbk As Excel.Workbook 
    Dim wst As Excel.Worksheet 
    Dim cn As ADODB.Connection 
    Dim rs As ADODB.Recordset 
    Dim rs1 As ADODB.Recordset 
    Dim rs2 As ADODB.Recordset 
    Dim LR As Long 
    Dim startcell As Range 
    DoCmd.RunMacro "Guardarmcr" 

     Set appXL = CreateObject("Excel.Application") 
     appXL.Visible = True 
     Set wbk = appXL.Workbooks.Add 
     Set wst = wbk.Worksheets(1) 
     Set startcell = Range("D16") 

     Set cn = CurrentProject.AccessConnection 
     Set rs = New ADODB.Recordset 
     Set rs1 = New ADODB.Recordset 
     Set rs2 = New ADODB.Recordset 


     With rs 
     Set .ActiveConnection = cn 
     .Source = "SELECT * FROM ExcelTitulotbl" 
     .Open 
     End With 

     With rs1 
     Set .ActiveConnection = cn 
     .Source = "SELECT * FROM Excelotptbl" 
     .Open 
     End With 

     With rs2 

     Set .ActiveConnection = cn 
     .Source = "SELECT * FROM ExcelEDTUDCtbl" 
     .Open 

     End With 


     With wst 
     '.QueryTables.Add Connection:=rs, Destination:=.Range("A1") 
     '.QueryTables(1).Refresh 


     .QueryTables.Add Connection:=rs1, Destination:=.Range("d16") 
     .QueryTables(1).Refresh 


     .Range("A16").EntireRow.Delete 
     .Range("e2").Font.Bold = True 
     .Range("e2").Font.Name = "Calibri" 
      .Range("e2").Font.Size = 14 

     .Range("e2") = "VALORACION" 
     .Range("D5") = "Descripción" 
     .Range("j5") = "Profesional Colaborador" 
     .Range("j6") = "Profesional Chilectra" 
     .Range("e5") = rs("proyectoMain") 
     .Range("k5") = rs("Empleado") 
     .Range("k6") = rs("chilectramain") 

     .Range("B15") = "Recargo" 
     .Range("D15") = "Número" 
     .Range("E15") = "Apdto" 
     .Range("F14") = "Tipo" 
     .Range("F15") = "Ocurrencia" 
     .Range("g15") = "Especialidad" 
     .Range("h14") = "Tipo" 
     .Range("h15") = "Activo" 


      TotalE 

     End With 
    wbk.Saved = True 
    Set wks = Nothing 
      Set wbk = Nothing 

      Set appXL = Nothing 

    End Sub 

Большинство из них работает хорошо, но если я пытаюсь запустить команду во второй раз открывает рабочий лист, но УВА не удается показывая ошибку 1004. Это как-то связано с LR = Range("E" & Rows.Count).End(xlUp).Row. Если я уйду из формы и войду в нее снова, она будет работать в первый раз, но не через секунду.

Поблагодарите за это помощь, спасибо.

Answer 1

Похоже, вы вызываете подпрограмму TotalE, но в ней вы не указали диапазон явно, какую книгу использовать. Activeworkbook.Range() может быть лучше или когда вы добавляете книгу, запишите имя и передайте его подпрограмме.

Странно, но вы только вычисляете последнюю строку в столбце E и помещаете это значение + 2 в столбец D двумя рядами вниз.

Все, что вам действительно нужно, это код, чтобы заменить вызов Тотал:

ActiveWorkbook.Sheets(1).Range("D" & ActiveWorkbook.Sheets(1).Range("E" & Rows.Count).End(xlUp).Row + 2) = ActiveWorkbook.Sheets(1).Range("E" & Rows.Count).End(xlUp).Row + 2 
End Sub