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

大多数都可以正常工作，但如果我尝试运行该命令，则第二次打开工作表，但vba无法显示1004错误。它与LR = Range("E" & Rows.Count).End(xlUp).Row有关。如果我退出表格并再次输入，它将首次运行，但不是第二次。

非常感谢您的帮助，谢谢。

Answer 1

看起来你正在调用TotalE子例程，但在其中你没有明确地告诉范围使用什么工作簿。 Activeworkbook.Range（）可能更好，或者当您添加工作簿时，捕获名称并将其传递给子例程。

奇怪，但你只计算E栏的最后一行，并将该值+ 2放入D列两行。

您真正需要的是此代码替换您对TotalE的调用：

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

将数据传输到Excel

1 个答案: