插入" dummy"使用VBA通过Access在Excel中排

时间:2017-05-03 18:18:16

标签: excel vba excel-vba

我尝试通过使用VBA访问将一条虚线插入excel文件。我将以下内容附加到访问按钮,当我运行它时,我得到:"编译错误:Sub或Function未定义"

Sub Command10_Click()

Dim objActiveWkbk As Object Dim objActiveWksh As Object Dim objXL As Object Dim strWkbkName As String

strWkbkName = "C:\data\Payroll.csv"

Set objXL = CreateObject("excel.application") objXL.Application.ActiveWorkbook Set objActiveWksh = objActiveWkbk.worksheets("Payroll.csv")

Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "2500"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "1500"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("T2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("V2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("W2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("X2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("Y2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("Z2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AA2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AC2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AD2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AE2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AF2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AG2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AH2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AJ2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AK2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AL2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AM2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AN2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AO2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AP2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AQ2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AR2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AS2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AT2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AU2").Select
    ActiveCell.FormulaR1C1 = "BBB"
    Range("AV2").Select
    ActiveWorkbook.Save

objActiveWkbk.Close SaveChanges:=False   Set objActiveWkbk = Nothing   objXL.Application.Quit   Set objXL = Nothing End Sub




Private Sub Command4_Click() DoCmd.OpenQuery "qry_CARS Capps Compile"

End Sub

Private Sub Command8_Click() DoCmd.TransferText acImportDelim, , "CARS Capps B", "P:\EMI\Drop\CARS Capps.csv", True

End Sub

Public Sub Import_CARS_Capps_Click() Dim xlApp As Object Dim xlBook As Object

xlApp.Visible = True

Set wbExcel = xlApp.Workbooks.Add Set xlBook = xlApp.Workbooks.Open("P:\EMI\Drop\CARS Capps.csv")        'ie "C:\My Documents\Data To Import.xlsx" xlApp.DisplayAlerts = False Workbook("CARS Capps.csv").Activate
        Sheets("Sheet1").Activate                                        'Sheet1 should be the actual name of your work sheet
        Range("a2").Select
        ActiveCell.EntireRow.Insert                                        'Insert a row below the header
        Cells(2, 1).Value = "aaa" Cells(2, 2).Value = "aaa" Cells(2, 3).Value = "aaa" Cells(2, 4).Value = "aaa" Cells(2, 5).Value = "aaa" Cells(2, 6).Value = "aaa" Cells(2, 7).Value = "5555" Cells(2, 8).Value
= "5555" Cells(2, 9).Value = "aaa" Cells(2, 10).Value = "aaa" Cells(2, 11).Value = "aaa" Cells(2, 12).Value = "aaa" Cells(2, 13).Value = "aaa" Cells(2, 14).Value = "aaa" Cells(2, 15).Value = "aaa" Cells(2, 16).Value = "aaa" Cells(2, 17).Value = "aaa" Cells(2, 18).Value = "aaa" Cells(2, 19).Value = "aaa" Cells(2, 20).Value = "aaa" Cells(2, 21).Value = "aaa" Cells(2, 22).Value = "aaa" Cells(2, 23).Value = "aaa" Cells(2, 24).Value = "aaa" Cells(2, 25).Value = "aaa" Cells(2, 26).Value = "aaa" Cells(2, 27).Value = "aaa" Cells(2, 28).Value = "aaa" Cells(2, 29).Value = "aaa" Cells(2, 30).Value = "aaa" Cells(2, 31).Value = "aaa" Cells(2, 32).Value = "aaa" Cells(2, 33).Value = "aaa" Cells(2, 34).Value = "aaa" Cells(2, 35).Value = "aaa" Cells(2, 36).Value = "aaa" Cells(2, 37).Value = "aaa" Cells(2, 38).Value = "aaa" Cells(2, 39).Value = "aaa" Cells(2, 40).Value = "aaa" Cells(2, 41).Value = "aaa" Cells(2, 42).Value = "aaa" Cells(2, 43).Value = "aaa" Cells(2, 44).Value = "aaa" Cells(2, 45).Value = "aaa" Cells(2, 46).Value = "aaa" Cells(2, 47).Value = "aaa" Cells(2, 48).Value = "aaa" Cells(2, 49).Value = "aaa" Cells(2, 50).Value = "aaa" Cells(2, 51).Value = "aaa" Cells(2, 52).Value = "aaa" Cells(2, 53).Value = "aaa" Cells(2, 54).Value = "aaa" Cells(2, 55).Value = "aaa" Cells(2, 56).Value = "aaa" Cells(2, 57).Value = "aaa" Cells(2, 58).Value = "aaa" Cells(2, 59).Value = "aaa" Cells(2, 60).Value = "aaa" Cells(2, 61).Value = "aaa"

xlBook.Save Workbooks("Cars Capps.csv").ClosexlApxlApp.Quit xlApp.DisplayAlerts = True Set xlBook = Nothing Set xlApp = Nothing


End Sub

1 个答案:

答案 0 :(得分:1)

我可以看到Sub Command10_Click()中有一些直接问题会导致代码失败。我将在下面说明。

这一切看起来都不错:

Dim objActiveWkbk As Object
Dim objActiveWksh As Object
Dim objXL As Object
Dim strWkbkName As String

strWkbkName = "C:\data\Payroll.csv"

Set objXL = CreateObject("excel.application")

但下一行错误:Set objActiveWkbk = objXL.Application.ActiveWorkbook

您要求VBA设置不存在的对象。在上面的语句中,您创建了一个Excel对象,但尚未创建已附加到Excel对象的实际工作簿。

那就是说,将行改为

Set objActiveWkbk = objXL.Workbooks.Open(strWkbName)

创建对象。

然后这一行将起作用:

Set objActiveWksh = objActiveWkbk.Worksheets("Payroll.csv")

(请注意,工作表名称 实际 .csv结尾。如果没有,请相应地进行编辑)

但是,其余代码将中断,因为您没有将属性或方法限定为Excel对象。 Access无法理解RowsRangeSelection等。它不是Access VBA对象模型语法的一部分,因此Access在查看时不会知道该怎么做。 是Excel对象模型的一部分,因此您只需通过分配父级来告诉Access VBA。

使用阻止是一种快速有效的方法。

With objActiveWksh
    .Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

还要注意我如何重构该语句以摆脱Select的东西。你不需要它。它会降低代码速度并使其难以维护。而是直接使用对象。 (极少数情况下需要选择)。

所以,继续......

    .Range("A2:F2").Value = "BBB" 'set them all at once
    .Range("G2").Value = "2500"
    .Range("H2").Value = "1500"
    .Range("J2:AA2").Value = "BBB" 'set them all at once
End With

然而,老实说,我很困惑为什么你创建一个工作簿然后关闭它而不保存更改,但其余的看起来很好。

objActiveWkbk.Close SaveChanges:=False
Set objActiveWkbk = Nothing
objXL.Application.Quit
Set objXL = Nothing