-
1. Data: 2009-10-16 08:42:45
Temat: [VBA] Kopiowanie tabel Excela.
Od: Tadek <t...@g...com>
Witam.
Mam dwa pliki Excela: plik1.xlt i plik2.xls. W plik1.xlt jest jedna
tabela ("SV"), którą trzeba skopiować do plik2.xls (gdzie może być
więcej niż jedna). Całość jest wywoływana przyciskiem z formularza
Accessa i powinna się odbyć w tle, przy czym po skończeniu operacji
powinniśmy otrzymać na ekranie plik2.xls z otwartą tabelą, którą przed
chwilą skopiowaliśmy (dobrze by było, żeby była jako ostatnia
zakładka).
Przerobiłem kilkanaście opcji znalezionych w sieci na forach i na
stronach MS. Żadna nie działa. Albo działa tylko z Office najnowszym,
albo najstarszym albo z VB (bez 'A')...
A ja mam Office 2003 i prośbę, gdyby ktoś mnie naprowadził na trop.
Chwilowo jestem gdzieś tu: (Sorry za bajzel, ale jak pisałem, jakiś
czas już kombinuję i zamiast kasować 'zakomentowuję' - może się przyda
przy następnej próbie...)
Private Sub btn_tplacz_Click()
On Error GoTo error
Dim tp As excel.Application
Dim vr As excel.Application
Dim excel As excel.Application
Dim vr_plik As String
Dim tp_plik As String
Dim tp_s As Worksheet
Dim vr_s As Worksheet
Dim tp_wb As Workbook
Dim vr_wb As Workbook
Dim NumofWorksheets As Integer
vr_plik = "plik1.xlt"
tp_plik = "plik2.xls"
Set excel = GetObject(, "Excel.Application")
dalej:
'Set vr = GetObject(, "Excel.Application")
Set tp_wb = Workbooks.Open(tp_plik)
Set vr_wb = Workbooks.Open(vr_plik)
Set vr_s = Worksheets("SV")
Set vr_s = ActiveSheet
NumofWorksheets = tp_wb.Sheets.count
'vr.Workbooks.Open (vr_plik)
' tp.Sheets(Sheet.count).Select
vr_s.Select
vr_s.Activate
' vr_s.Copy after:=Workbooks(tp_wb).Sheets(Sheets.count)
vr_s.Copy after:=tp_wb.Worksheets(1)
' tp_wb.Sheets(NumofWorksheets).Paste
' vr.Sheets("SV").Activate
tp_wb.Activate
tp_wb.Sheets("SV").Activate
'vr.Workbooks.Close
tp.Workbooks.Open (tp_plik)
' vr.Sheets("SV").Select
'tp.Sheets("SV").Activate
'tp_s = tp.Worksheets.Item(1)
'vr_s = vr.Worksheets.Item(1)
'vr.Sheets("SV").Copy Destination:=tp '.Sheets(Sheets.count)
' Destination:=ActiveSheet.Cells(1, 1)
' ActiveSheet.name = "SV"
Exit Sub
error:
Select Case Err.Number
Case 429
Set tp = CreateObject("Excel.Application")
Resume dalej
Case 1004
MsgBox "Plik nieznaleziony", vbCritical
' vr.Quit
' tp.Quit
Set vr = Nothing
Set tp = Nothing
Exit Sub
Case Else
MsgBox Err.Description
End Select
'vr.Quit
'Set vr = Nothing
'Set tp = Nothing
End Sub