eGospodarka.pl
eGospodarka.pl poleca

eGospodarka.plGrupypl.comp.programming[VBA] Kopiowanie tabel Excela.
Ilość wypowiedzi w tym wątku: 1

  • 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

strony : [ 1 ]


Szukaj w grupach

Szukaj w grupach

Eksperci egospodarka.pl

1 1 1

Wpisz nazwę miasta, dla którego chcesz znaleźć jednostkę ZUS.

Wzory dokumentów

Bezpłatne wzory dokumentów i formularzy.
Wyszukaj i pobierz za darmo: