Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 70548 Skopiuj do schowka Z tabeli Worda do Excela
Autor Wiadomość
LeszekJ 
Forumowicz


Posty: 13
Wysłany: 30-03-2021, 13:35   Z tabeli Worda do Excela

Tabela w Wordzie posiada pola tekstowe formularza. Dane wpisane do nich mają być przeniesione jako baza danych w arkuszu Excela. W pliku Excela jest jeden arkusz z nagłówkami w pierwszym wierszu. Poniżej mają być dopisywane dane po kliknięciu przycisku obok tabeli Worda. A więc będzie to kod VBA w Wordzie. Plik Excela baza.xls jest zamknięty. W dotychczasowym kodzie nie działa mi wiersz:

Kod:
objExcel.ActiveCell.FormulaR1C1 = Documents(strDok).FormFields("txtNazwisko").Result


Czy ktoś może mnie łaskawie oświecić o co tu chodzi?
Pola tekstowe w Wordzie mają zakładki "txtNazwisko" i "txtTelefon".
Całość kodu:

Kod:
Sub PrzeslijDoExcela()
    Dim objExcel As Excel.Application
    Dim strDok As String
   
    strDok = ActiveDocument.Name
    On Error GoTo BladPrzesylania
    Set objExcel = CreateObject("Excel.Application")
    With objExcel
        .Workbooks.Open ("D:\baza.xls")
        .ActiveSheet.Range("A1").Select
        .Selection.End(xlDown).Select
        .ActiveCell.Offset(1, 0).Select
        .ActiveCell.FormulaR1C1 = Documents(strDok).FormFields("txtNazwisko").Result
        .ActiveCell.Offset(0, 1).Select
        .ActiveCell.FormulaR1C1 = Documents(strDok).FormFields("txtTelefon").Result
        .ActiveWorkbook.Close SaveChanges:=True
        .Quit
    End With
    MsgBox "Informacje zostały prawidłowo przesłane", vbInformation + vbOKOnly, "Przesyłanie gotowe"
    Exit Sub
   
BladPrzesylania:
    Dim strBlad As String, strTytul As String
    Select Case Err.Number
        Case 1004 'brak pliku Excela
            strBlad = "Nie można przesłać danych, gdyż nie można "
            strBlad = strBlad & "znaleźć pliku baza.xlsx."
            strTytul = "Brakujący plik"
        Case 5941
            strBlad = "Nie ma pól w tym dokumencie." & vbNewLine & "Nie można więc przesłać danych."
            strTytul = "Brakujące pola"
        Case Else
            strBlad = "Wystąpił błąd " & Err.Number & " - " & Err.Description & ". Przesyłanie zatrzymane."
            strTytul = "Nieoczekiwany błąd"
    End Select
    MsgBox strBlad, vbExclamation + vbOKOnly, strTytul
    objExcel.Quit
End Sub


Dzięki z góry!

Formularz z przesyłaniem do Excela.doc
Pobierz Plik ściągnięto 8 raz(y) 45 KB

baza.xls
Pobierz Plik ściągnięto 8 raz(y) 29.5 KB

_________________
Leszek
ID posta: 402956 Skopiuj do schowka
 
 
Tajan


Pomógł: 4764 razy
Posty: 10465
Wysłany: 30-03-2021, 17:21   

Proponuję tak:
Kod:
Sub PrzeslijDoExcela()
    Dim objExcel As Excel.Application
    Dim strDok As Document
    Dim wolny As Long
   
    Set strDok = ActiveDocument
   
    On Error GoTo BladPrzesylania
   
    Set objExcel = CreateObject("Excel.Application")
   
    With objExcel
        With .Workbooks.Open("D:\baza.xls").ActiveSheet
             wolny = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
             .Cells(wolny, 1).Value = strDok.FormFields("txtNazwisko").Result
             .Cells(wolny, 2).Value = strDok.FormFields("txtTelefon").Result
         End With
        .ActiveWorkbook.Close SaveChanges:=True
        .Quit
    End With
   
    MsgBox "Informacje zostały prawidłowo przesłane", vbInformation + vbOKOnly, "Przesyłanie gotowe"
   
    Exit Sub
   
BladPrzesylania:
    Dim strBlad As String, strTytul As String
    Select Case Err.Number
        Case 1004 'brak pliku Excela
            strBlad = "Nie można przesłać danych, gdyż nie można "
            strBlad = strBlad & "znaleźć pliku baza.xlsx."
            strTytul = "Brakujący plik"
        Case 5941
            strBlad = "Nie ma pól w tym dokumencie." & vbNewLine & "Nie można więc przesłać danych."
            strTytul = "Brakujące pola"
        Case Else
            strBlad = "Wystąpił błąd " & Err.Number & " - " & Err.Description & ". Przesyłanie zatrzymane."
            strTytul = "Nieoczekiwany błąd"
    End Select
    MsgBox strBlad, vbExclamation + vbOKOnly, strTytul
    objExcel.Quit
End Sub
ID posta: 402981 Skopiuj do schowka
 
 
LeszekJ 
Forumowicz


Posty: 13
Wysłany: 30-03-2021, 18:01   

Dzięki Tajan :-)
Twoja wiedza opromienia nie tylko najbliższą okolicę, ale cały glob ziemski :-D
_________________
Leszek
ID posta: 402983 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe