2013-06-24 2 views
1

Я пытаюсь скопировать таблицу Excel в другую книгу из Access и продолжать получать ошибку индекса. Я пробовал несколько разных вещей, но, похоже, не мог прибить его. Любая помощь будет оценена по достоинству. Использование Access и Excel 2010 и мой код выглядит следующим образом:Пытается скопировать лист Excel в другую книгу из Access.

Dim strTaxMonth As String 
Dim strTaxYear As String 
Dim strTabName As String 
Dim objExcel As Excel.Application 
Dim objWB As Workbook 
Dim objWS As Worksheet 
Dim strExcelFile0 As String 
Dim strExcelFile1 As String 
Dim strExcelFile2 As String 

strTaxMonth = Forms!frm_PayrollTax_Report!ReportMonth 
strTaxYear = Forms!frm_PayrollTax_Report!ReportYear 
strTabName = strTaxMonth & strTaxYear & "_PTAX" 
strExcelFile0 = "C:\File0.xlsm" 
strExcelFile1 = "C:\File1.xlsx" 
strExcelFile2 = "C:\File2.xlsm" 


'Copy Worksheet to Yearly File 


Set objExcel = New Excel.Application 
objExcel.Visible = True 
objExcel.DisplayAlerts = False 

If Len(Dir(strExcelFile1)) > 0 Then Kill strExcelFile1 

Set objWB = objExcel.Workbooks.Open(strExcelFile0) 
objWB.Activate 
Set objWS = objExcel.Sheets("PTAX") 
objWS.Activate 
objWS.Unprotect 
objWS.Select 
objWS.Name = strTabName 
objWS.Range("A1:I16").Select 
objWS.Range("A1:I16").Copy 
objWS.Range("A1:I16").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone 
objWS.Range("B19:I28").Select 
objWS.Range("B19:I28").Copy 
objWS.Range("B19:I28").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone 
objWS.Protect 
objWS.Select 
objExcel.Workbooks.Open(strExcelFile0).Sheets(strTabName).Copy After:=objExcel.Workbooks.Open(strExcelFile2).Sheets("YTD PTAX") 
objExcel.Workbooks(strExcelFile0).Activate 
objExcel.ActiveWorkbook.SaveAs strExcelFile1 
objExcel.ActiveWorkbook.Close False 
objExcel.Quit 
Set objExcel = Nothing 
Set objWB = Nothing 
Set objWS = Nothing 

End Sub 

ответ

1

Просто используйте этот кусок кода

Sub test() 

    Dim xlapp as New Excel.Application 
    Dim xlwkb as Workbook 
    Dim xlsht as Worksheet 
    Dim xlwkb2 as Workbook 
    Dim xlsht2 as Worksheet 

    xlapp.DisplayAlerts=False 

    'First workbook and Sheet 
     Set xlwkb=xlapp.Workbooks.Open(strExcelFile0) 
     Set xlsht=xlwkb.Worksheets(1) 

    'Second workbook and Sheet 
     Set xlwkb2=xlapp.Workbooks.Open(strExcelFile0) 
     Set xlsht2=xlwkb.Worksheets(1) 

     xlsht.Range("A1:B16").Copy Destination:=xlsht2.Range("A1") 

     Set xlsht=Nothing 
     xlwkb.Close 
     Set xlwkb=Nothing 

     xlwkb2.Saveas "C:\File.xls" 
     Set xlsht2=Nothing 
     xlwkb2.Close 

    xlapp.DisplayAlerts=True 

     Set xlapp=Nothing 
     xlapp.Quit 

End Sub