fbpx

Zapisz plik pod nazwą wskazaną w komórce (VBA)

18.02.2019 | ECP3, Makra VBA

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

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:

  1. NowaNazwa
  2. Sciezka
  3. 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 Sub

W 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 Sub

PS 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

Kod w edytorze

Mam nadzieję, że opisane powyżej makro ułatwi Ci pracę. Jeśli znajdziesz w nim wartość – miło mi będzie, jak udostępnisz ten wpis innym. Może im też się przyda? Może spędzili dużo czas i przeszukali pół Internetu, żeby znaleźć takie rozwiązanie? A może tak było w Twoim przypadku, to wiesz o co chodzi 😉 Tym bardziej więc udostępnij proszę ten wpis! Razem możemy im ułatwić innym życie 🙂

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:

 

 

 

Jeżeli chcesz lepiej poznać makra i VBA zapisz się na listę zainteresowanych kursem Excel w codziennej pracy cz. 3! Podczas oczekiwania na kurs będę Ci wysyłała informacje, ciekawostki i excelowe triki. Bezpłatnie! 

Pomogłam Ci? Postaw mi wirtualną kawę! →

Przeczytaj podobne wpisy

Kategorie

15 komentarzy

  1. 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

    Reply
    • 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ć 🙂

      Reply
  2. 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 🙂

    Reply
    • Hej, trzeba to zrobić przy użyciu pętli, w której sczytywane są te dane z zakresu A2:B5 🙂

      Reply
  3. 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

    Reply
    • 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 🙂

      Reply
  4. 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.

    Reply
    • Super, że Ci się przydało 🙂
      Myślę, żę w takiej sytuacji najprościej byłoby użyć metody SaveAs, zamiast Save :).

      Reply
  5. 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

    Reply
    • 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

      Reply
      • Uff, to cieszę się, że już działa i że się udało!

        Reply
  6. 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 😉

    Reply
    • 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

      Reply
      • prawdopodobnie w usłudze onedrive nie działa ostrzeżenie o tym, że kopia pliku zgodnie z nazwą komórki jest zapisana

        Reply
  7. 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

    Reply

Leave a Reply to goa2004 Anuluj pisanie odpowiedzi

Twój adres e-mail nie zostanie opublikowany. Wymagane pola są oznaczone *

Pin It on Pinterest