Skocz do zawartości


Close Open
Close Open
Zdjęcie
- - - - -

VBA - kopiowanie danych pomiędzy arkuszami (w obie strony)

VBA przycisk kopiowanie makro automatyzacja zapisywanie excel

  • Please log in to reply
3 replies to this topic

#1 cikawy

cikawy

    Adept

  • Forumowicze
  • Pip
  • 2 Postów:

Napisany 06 luty 2018 - 13:34

Witam,

staram się stworzyć arkusz, który wspomoże wystawianie dokumentów zgodnie z moimi potrzebami.

 

Makro kopiuje dane z pliku 'Baza' (odbiorca, osoba kontaktowa itp.) do 'WZ', następnie uzupełnia kilka informacji w 'WZ'.

Na koniec kopiuje jedną informację (nr WZ) do pliku 'BAZA' i zapisuje plik 'WZ' oraz jego kopię w innej lokalizacji.

 

Udało mi się osiągnąć zamierzony cel, jednak pojawiła się przeszkoda nie do pokonania - dla mnie ;/

Przycisk z kodem uruchamiającym całą procedurę działa tylko dla konkretnych pól formularza. 

Żeby wszystko działało w pełni musiałbym wstawić 4 przyciski dla obsługi każdego wiersza, a wierszy planuję zrobić ok 250 co daje 1000 buttonów.

Nie byłby to problem, gdyby nie fakt, że każdego musiałbym osobno opisać dla konkretnych komórek formularza.

[Nie zawsze wszystkie 4 buttony miałyby zastosowanie jednocześnie, jednak musi być taka możliwość - zazwyczaj tylko 1 w danym wierszu będzie wykorzystany]

 

 

Teraz moje pytanie:

Czy jest możliwe napisanie takiego kodu, który w prosty sposób pozwoli na realizację zadania dla innych przycisków, które powinny działać na innych wierszach formularza? Najlepiej bez konieczności przerabiania kodu dla każdego nowego przycisku - lub tylko minimalna edycja, nie narażająca na powstanie błędu przy tworzeniu dużej ilości kodu o prawie identycznej budowie.

 

W zamieszczonym poniżej przykładzie odbywa się to następująco:

http://prntscr.com/iaus5h
 

Przycisk '1a' wykonuje procedurę kopiowania dla dokumentu 'WZ_PUPH' z  danymi zawartymi w wierszu 3.

Potrzebuje to samo zrobić dla kolejnych przycisków poniżej '1a' (2a, 3a,4a... 250a), to samo będzie się tyczyło kolejnych przycisków oznaczonych kolejnymi literkami (b,c,d).

 

Poniżej kod dla przycisku 1a:

Sub WZ_PUPH()
'
' WZ_PUPH Makro
'
Dim data As Date
' otwarcie DOKUMENTU (WZ CMR)
    Range("S2").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
' ustawienie aktualnej daty
    Range("M3").Select
    Range("M3") = Now()
' zwiększenie numeru dokumentu o 1
    Range("G12").Value = Range("G12").Value + 1
' kopiowanie numeru dokumentu do zestawienia
    Range("G12").Select
    Selection.Copy
    Windows("BAZA_DOKUMENTOW.xlsm").Activate
    Range("P3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' kopiowanie numeru ZAMÓWIENIA do dokumentu wysyłkowego
    'Windows("BAZA_DOKUMENTOW.xlsm").Activate
    Range("K3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("WZ_PUPH.xlsm").Activate
    Range("M12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' kopiowanie odbiorcy do dokumentu
    Windows("BAZA_DOKUMENTOW.xlsm").Activate
    Range("G3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("WZ_PUPH.xlsm").Activate
    Range("H8:K10").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
' kopiowanie osoby kontaktowej
    Windows("BAZA_DOKUMENTOW.xlsm").Activate
    Range("H3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("WZ_PUPH.xlsm").Activate
    Range("L8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' kopiowanie nazwy towaru lub usługi
    Windows("BAZA_DOKUMENTOW.xlsm").Activate
    Range("I3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("WZ_PUPH.xlsm").Activate
    Range("C17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' kopiowanie ilości jaka została wysłana z tym dokumentem
    Windows("BAZA_DOKUMENTOW.xlsm").Activate
    Range("M3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("WZ_PUPH.xlsm").Activate
    Range("H17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'ZWYKŁE zapisanie dokumentu
    ActiveWorkbook.Save ' zapisanie dokumentu
' zapisanie kopii dokumentu w odpowiednim folderze
    Range("G12").Select
    Dim Sciezka As String
    Sciezka = "G:\_ZAMOWIENIA\2018\001\" 'gdzie ma byc zapisany
    On Error Resume Next
    ActiveWorkbook.SaveAs Filename:=Sciezka & "WZ_" + ActiveCell.Text & "_" & Format(Date, "yyyy-mm-dd")
'----------------------------------
End Sub

Akceptowalne dla mnie byłoby, gdyby kod realizował zadanie dla wiersza filtrowanego po np. numerze z liczby porządkowej LP.

http://prntscr.com/iauxx2

Czyli zostałby jeden widoczny wiersz i dane dla takiego wiersza brały by udział w całym procesie kopiowania itp. - jednak nie mogę sobie z tym poradzić ;/

 

Być może są jeszcze inne sposoby na rozwiązanie problemu?

 

 



#2 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 574 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 13 luty 2018 - 20:16

1. Przede wszystkim metoda "Select" jest chyba najgorsza w tym przypadku.

2. Łatwiej by było jakbyś podesłał przykładowe pliki.



#3 cikawy

cikawy

    Adept

  • Forumowicze
  • Pip
  • 2 Postów:

Napisany 21 luty 2018 - 08:15

Nie uważam, że zrobiłem to najlepiej jak można i jestem otwarty na wszelkie sugestie :)

 

Nie udało mi się tutaj załadować plików, więc daję link zewnętrzny

 


#4 Calculatic

Calculatic

    Adept

  • Forumowicze
  • Pip
  • 1 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Wrocław

Napisany 16 maj 2018 - 12:52

W razie kolejnych problemów z VBA bardzo proszę o prywatną wiadomość, chętnie pomogę 


W razie problemów z programowaniem VBA napisz prywatną wiadomość.




0 Użytkowników czyta ten temat

0 użytkowników, 0 gości, 0 anonimowych użytkowników