Czyli trochę o „zabijaniu” plików
Naszym celem jest to, aby za każdym razem, gdy będziemy zamykać plik – zapisywał się on pod nazwą wskazaną w jednej z komórek arkusza. Formatka zawiera więc tylko tę komórkę, która zawiera przyszłą nazwę pliku:
Formatka
Komórkę tę warto nazwać, aby ułatwić namierzanie jej w kodzie VBA, bo taki właśnie będziemy pisać, aby rozwiązać to zadanie. Komórkę nazwałam jako „Komorka” i takiego odwołania do niej będę używała dalej (tutaj, w sekcji Nazywanie komórek, dowiesz się jak nazywać komórki).
Rozwiązanie będzie bazowało na zdarzeniu skoroszytu BeforeClose. Tworzenie zdarzenia skoroszytu (Workbook) opisałam tutaj. W naszym przypadku trzeba będzie tylko wybrać zdarzenie BeforeClose.
Teraz już czas na kod.
Potrzebujemy 3 zmiennych:
- NowaNazwa
- Sciezka
- StaraNazwa
Wszystkie tekstowe, czyli typu String.
Czemu akurat takie? Ponieważ nasze makro będzie działało tak, że przed zamknięciem pliku zapisze go pod nową nazwą (opcja: zapisz jako), a następnie stary plik usunie. Usuwanie oczywiście można pominąć, jeśli chcemy tworzyć backup poprzednich plików – ja osobiście bym tak wolała. Będzie to kwestia jednej linijki kodu i to, czy ją pisać czy nie, zostawię Tobie, drogi Czytelniku :).
Żeby to zapisywanie (w odpowiednim miejscu!) i usuwanie działało, należy znać starą nazwę (aby wiedzieć, co usuwać), nową nazwę – żeby wiedzieć jak nazwać nowy plik, i ścieżkę, aby wiedzieć gdzie to wszystko ma się dziać (oczywiście w bieżącym folderze).
Mamy więc deklarację zmiennych i przypisywanie do nich wartości:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim NowaNazwa As String, Sciezka As String, StaraNazwa As String
StaraNazwa = ThisWorkbook.Name
NowaNazwa = Dane.Range("Komorka") & ".xlsm"
Sciezka = ThisWorkbook.Path & "\"
End SubW sytuacji, gdy nowy i stary plik mają tę samą nazwę (zakładam, że może się zdarzyć taka sytuacja) – nie będziemy wykonywać żadnej operacji, ponieważ nazwa pliku jest poprawna. Przerwiemy wtedy działanie makra. Robi to poniższa linijka:
If NowaNazwa = StaraNazwa Then Exit Sub
Jeśli jednak nazwy się różnią (o to w sumie chodzi), zostaje teraz już zapisanie pliku pod nową nazwą (Zapisz jako):
ThisWorkbook.SaveAs Sciezka & NowaNazwa
… i skasowanie poprzedniego pliku (jeśli nie chcesz kasować – tej linijki nie pisz):
Kill Sciezka & StaraNazwa
Śmieszna instrukcja, prawda? 🙂 Tylko uwaga! Bardzo niebezpieczna, ponieważ ona po prostu usuwa plik z dysku! BTW: dlatego też w pliku do pobrania, który znajdziesz pod koniec artykuły, w kodzie nie ma tej linijki, aby Twój antywirus nie zablokował pobierania ;). Bezpieczeństwo przede wszystkim!
Jeszcze do tego kodu warto dodać wyłączanie komunikatów np. o nadpisaniu pliku (gdy nowy i stary mają tę samą nazwę). Wszystko razem wygląda tak:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim NowaNazwa As String, Sciezka As String, StaraNazwa As String
StaraNazwa = ThisWorkbook.Name
NowaNazwa = Dane.Range("Komorka") & ".xlsm"
Sciezka = ThisWorkbook.Path & "\"
If NowaNazwa = StaraNazwa Then Exit Sub
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Sciezka & NowaNazwa
Kill Sciezka & StaraNazwa
Application.DisplayAlerts = True
End SubPS W każdym miejscu tego kodu, gdzie występuje ThisWorkbook, można użyć słówka kluczowego me. W tym przypadku będzie ono oznaczało to samo.
Wrzucam jeszcze screen edytora – zwróć szczególną uwagę na zaznaczone fragmenty:
Kod w edytorze
A oto plik do pobrania (nie zawiera instrukcji kasującej plik!):
MalinowyExcel Zapisz plik pod nazwą wskazaną w komórce VBA dw.zip
Chcesz nauczyć się pisać makra w Excelu?
A jeśli chcesz nauczyć się pisać makra od zera – koniecznie zapisz się na listę zainteresowanych moim kursem wprowadzającym do pisania makr Excel w codziennej pracy cz. 3.! Zapis jest bezpłatny, podobnie jak cotygodniowe artykuły, które lądują prosto na Twojego maila :).
I wideo:
Witam,
a czy mogłaby Pani podać wskazówki jaki napisać kod tworzący nowy folder o nazwie z zaznaczonej komórki (komórka będzie
się zmieniać), z tym że nazwa w komórce jest funkcją (złącz.teksty) , a następnie aby ta nazwa stawała się hiperłączem do tego folderu?
Z góry dziękuję za pomoc
Hej,
do tworzenia folderu służy w VBA konstrukcja MkDir. Trzeba byłoby jej podać ścieżkę i nazwę folderu, a następnie stworzyć do niego link. Pytanie jak to miałoby wyglądać, ponieważ łącze można stworzyć funkcją HIPERŁĄCZE w komórce obok, a jak to nie będzie dobrym rozwiązaniem, to już przez VBA. Tworzenie łącza można nawet nagrać 🙂
Dzień dobry,
Jak stworzyć makro, które będzie zapisywało plik pod kilkoma nazwami wskazanymi w komórkach (np.A2:A5) do odpowiadających im lokalizacji wskazanych w komórkach B2:B5.
Z góry dziękuję za pomoc 🙂
Hej, trzeba to zrobić przy użyciu pętli, w której sczytywane są te dane z zakresu A2:B5 🙂
Witam. Korzystając z filmiku powyżej chciałam stworzyć makro zapisujące poszczególne arkusze w osobnych plikach, każdy o nazwie z komórki R2 danego arkusza, ale coś nie chce zapisywać pliku. Czy gdzieś jest błąd?
Sub PLIKI ()
Dim WS As Worksheet
Dim Sciezka As String
Dim NowaNazwa As String
Sciezka = ThisWorkbook.Path & „\”
NowaNazwa = Range(„R2”).Value & „.xlsx”
For Each WS In ThisWorkbook.Worksheets
WS.Copy
ActiveWorkbook.SaveAs Sciezka & NowaNazwa
ActiveWorkbook.Close SaveChanges:=True
Next WS
End Sub
Hej,
ja bym podmieniła to:
ActiveWorkbook.SaveAs Sciezka & NowaNazwa
ActiveWorkbook.Close SaveChanges:=True
Dim NowyPlik As Workbook
Set NowyPlik = Workbooks.Add
Sheets(1).Copy before:=NowyPlik.Sheets(1)
NowyPlik.Sheets(2).delete
NowyPlik.SaveAs „NowaNazwa.xlsx”
Żeby zamykać nowy plik, a nie nasz, z którego odpalamy makro 🙂
Kolejne mega ciekawe rozwiązanie które mogło by ułatwić życie. Ale mam problem. Jak zedytować kod aby powstał nowy plik ale przez kliknięcie „zapisz” i formularz był cały otwarty aby można było tworzyć kolejne pliki z nową nazwą? Próbowałem z beforesave ale po stworzeniu pliku pod nową nazwą zamyka mi formularz.
Super, że Ci się przydało 🙂
Myślę, żę w takiej sytuacji najprościej byłoby użyć metody SaveAs, zamiast Save :).
Hej,
dlaczego to u mnie nie działa i podkreśla pierwszą i szóstą linie?
1/ Private Sub Workbook_BeforeClose(Cancel As Boolean)
2/ Dim NowaNazwa As String, Sciezka As String, StaraNazwa 3/ As String
4/
5/ StaraNazwa = ThisWorkbook.Name
6/ NowaNazwa = Dane do edycji.Range(„numer”) & „.xlsm”
Sciezka = ThisWorkbook.Path & „\”
If NowaNazwa = StaraNazwa Then Exit Sub
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Sciezka & NowaNazwa
Application.DisplayAlerts = True
End Sub
Dzięki ale już działa. Na filmiku 6 wiersz wygląda tak:
NowaNazwa = ThisWorkbook.Sheets(„Dane do edycji”).Range(„numer”) & „.xlsm”
a na stronie w kodzie:
NowaNazwa = Dane do edycji.Range(“numer”) & “.xlsm”
i chyba dlatego był błąd chociaż nie wiem z jakiej przyczyny. Wpisałem kod jaki jest na filmiku i działa:-), pozdrawiam
Uff, to cieszę się, że już działa i że się udało!
Fajny kod ułatwiający życie.
Pytanie.
Dlaczego nie mam możliwości zapisz jako ? tylko zapisz kopię.
a otwierając Twój plik taka opcja jest 😉
wyłączyłem autozapis to się opcja pojawiła
lecz nie ostrzega o tym, że plik o nazwie zgodnie z komorką został zapisany
kod poniżej
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim NowaNazwa As String, Sciezka As String, StaraNazwa As String
StaraNazwa = ThisWorkbook.Name
NowaNazwa = Worksheets(„Skład_zespołu”).Range(„komorka”) & „.xlsm”
Sciezka = ThisWorkbook.Path & „\”
If NowaNazwa = StaraNazwa Then Exit Sub
Application.DisplayAlerts = True
ThisWorkbook.SaveAs Sciezka & NowaNazwa
Application.DisplayAlerts = True
End Sub
prawdopodobnie w usłudze onedrive nie działa ostrzeżenie o tym, że kopia pliku zgodnie z nazwą komórki jest zapisana
Witam mam pytanie czy jest szansa jeśli mamy kilka arkuszy aby zapisywały się kazdy pod inna nazwa wskazana w komórce w danym arkuszu? czyli np. Mam arkusz1 i komurke B2 potem arkusz2 i arkusz3 w kazdym z nich w komórce B2 jest inna wartość.
Chciałabym zapisać je jako PDF odzielnie i zeby kazdy miał nazwę arkusz1 + wartość B2 nastepny plik Arkusz2 + wartość B2 (z arkusza2 ) jak próbuje skorzystac z tego kodu to i owszem zapisują mi sie pliki ale wszystkie w nazwie maja wartość komórki z pierwszego arkusza