从Access运行VBA以更改Excelfile

时间:2015-03-16 11:57:57

标签: excel vba access-vba

我试图从我的访问数据库运行一个脚本来改变刚刚由同一个脚本生成的excelfile。 我想制作一个循环遍历每个创建的工作表和工作簿的模块,同时执行一些基本任务。我对vba excel很新,所以我似乎无法找到出错的地方。在excel中,我使用宏录制器编写了第一个脚本。这很好。

我现在想制作一个脚本,在访问中复制这个excel宏,我已经尝试编写一个脚本(如下所示),但这似乎停止了以下操作:剪切和自动填充。 另外,当省略这些命令时,会弹出一个弹出窗口,其中我要求为每个循环覆盖现有文件,我想避免这种情况。

非常感谢您的任何帮助!

Excel代码:

Sub Macro1()
    Range("A1:A200").Select
    Selection.Copy
    Range("A201").Select
    ActiveSheet.Paste
    Range("A401").Select
    ActiveSheet.Paste
    Range("A601").Select
    ActiveSheet.Paste
    Range("V1:AO200").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("B201").Select
    ActiveSheet.Paste
    Range("AP1:BI200").Select
    Selection.Cut
    Range("B401").Select
    ActiveSheet.Paste
    Range("BJ1:CC200").Select
    Selection.Cut
    Range("B601").Select
    ActiveSheet.Paste
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "=IF(OR(AND(RC[-6]=FALSE,RC[-11]=FALSE,RC[-16]=FALSE,RC[-1]=FALSE),AND(RC[-6]="""",RC[-11]="""",RC[-16]="""",RC[-1]="""")),0,1)"
    Range("V1").Select
    Selection.AutoFill Destination:=Range("V1:V800")
    Range("V1:V800").Select
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$V$800").AutoFilter Field:=22, Criteria1:="0"
    Rows("2:1000").Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Columns("V:V").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
End Sub  `

访问代码:

For i = 1 To 7
   For j = 1 To 4
         DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, sCoun(i) & sQuer(j), myPath & sCoun(i) & ".xlsx"
                Set xlApp = New Excel.Application
                Set xlWB = xlApp.Workbooks.Open(myPath & sCoun(i) & ".xlsx")
                Set xlSh = xlWB.Sheets(sCoun(i) & sTab(j))

            xlSh.Range("A1:A200").Copy
            xlSh.Range("A201").PasteSpecial
            xlSh.Range("A401").PasteSpecial
            xlSh.Range("A601").PasteSpecial
            xlApp.CutCopyMode = False
            xlSh.Range("V1:AO200").Cut Destination:=Range("B201")
            xlSh.Range("AP1:BI200").Cut Destination:=Range("B401")
            xlSh.Range("BJ1:CC200").Cut Destination:=Range("B601")
            xlSh.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            xlSh.Range("V1").FormulaR1C1 = "=IF(OR(AND(RC[-6]=FALSE,RC[-11]=FALSE,RC[-16]=FALSE,RC[-1]=FALSE),AND(RC[-6]="""",RC[-11]="""",RC[-16]="""",RC[-1]="""")),0,1)"
            xlSh.Range("V1").AutoFill Destination:=Range("V1:V800")
            xlSh.Range("A1").AutoFilter
            xlSh.Range("$A$1:$V$800").AutoFilter Field:=22, Criteria1:="0"
            xlSh.Rows("2:1000").Delete Shift:=xlUp
            xlSh.Range("A1").AutoFilter
            xlSh.Columns("V:V").Delete Shift:=xlToLeft
            xlSh.Range("A1").Select

                xlWB.Save
                xlWB.Close
                xlApp.Quit
                Set xlApp = Nothing
         Next j
        Next i`

1 个答案:

答案 0 :(得分:1)

请尝试在Destination参数中用xlSh.Range替换Range。 - user3964075 5分钟前