Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Makro tworzące kopie pliku przy jego zapisie

09 Gru 2010 15:11 2450 8
  • Poziom 9  
    Witam,

    Mam mały problem z którym niestety nie mogę sobie poradzić. Potrzebuję makro, które po zapisaniu danego pliku tworzy jego kopię o nazwie godzina.minuta.sekunda_dzien.miesiac.rok we wskazanym folderze. Poniżej to co udało mi się stworzyć ;)

    Będę bardzo wdzięczny za korektę mojego makra.

    Code:
    Sub Dj()
    

    Dim Plik As Workbook
    Dim WS As Worksheet
    Dim Name As String
    Dim Hour As String
    Dim Minute As String
    Dim Second As String
    Dim Day As String
    Dim Month As String
    Dim Year As String
    Dim Path As String

    Second = Second(Now)
    ' a moze zamiast (now) zastosowac (Time)
    Minute = Minute(Now)
    Hour = Hour(Now)
    Day = Day(Date)
    Month = Month(Date)
    Year = Year(Date)
    Path = "\\Wplcswroclaw12m\bu_trailer_system\Projects\Current\After_Market\AM_current\Archive_To-Do"

    Name = Sesond & "." & Hour & "." & Minute & "_" & Day & "." & Month & "." & Year & "." & "xls"

    Set Plik = ThisWorkbook
    Set WS = ActiveSheet

    If Plik.Save Then
    ' a moze zamist Plik to ActiveWorkbook
    ' a moze zamiast if then po prostu funkcja on

    ActiveWorkbook.SaveAs FileName:="Path\Name"
    ' a moze zamiast ActiveWorkbook to Plik
    Else


    End Sub


    Pozdrawiam,
    Neke

    Proszę pamiętać o używaniu znaczników code. - arnoldziq
  • Moderator Programowanie
    1. Sformatuj po prostu
    Code:
    nazwa = Format(Now(), "hh.mm.ss_dd.mm.yy") & ".xls"


    2. Wykorzystaj zdarzenie Workbook_BeforeSave (ThisWorkbook).
  • Poziom 9  
    Po zaimplementowaniu rad makro teraz wygląda następująco


    Code:
    Private Sub ThisWorkbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    

    Dim Plik As Workbook
    Dim WS As Worksheet
    Dim Name As String
    Dim Path As String

    Path = "\\Wplcswroclaw12m\bu_trailer_system\Projects\Current\After_Market\AM_current\Archive_To-Do"
    Name = Format(Now(), "hh.mm.ss_dd.mm.yy") & ".xls"

    Set Plik = ThisWorkbook
    Set WS = ActiveSheet

    ActiveWorkbook.SaveAs FileName:="Path\Name"
    ' a moze zamiast ActiveWorkbook to Plik

    End Sub



    Jak jednak nie działało tak dalej nie działa :(

    Proszę pamiętać o używaniu znaczników code. - arnoldziq
  • Pomocny post
    Moderator Programowanie
    Wklej kod w zdarzenie arkusza.
    Stringi masz podstawione pod zmienne, więc
    Code:
    ActiveWorkbook.SaveAs FileName:=Path & "\" & Name
    Nie wiem, czy Excel nie zjeży się na te nazwy. Zmień na polskie: Sciezka, Nazwa.
    Usuń te dwie linie rozpoczynające się od "Set", są zbędne.

    Jeśli to ma być kopia oryginału (obie zapisane), to pierwsza linia
    Code:
    Thisworkbook.Save
  • Poziom 9  
    Po przerobkach jest tak:

    Code:
    Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
    

    Dim Nazwa As String
    Dim Sciezka As String

    Sciezka = "D:\"
    Nazwa = Format(Now(), "hh.mm.ss_dd.mm.yy") & ".xls"

    ThisWorkbook.Save
    ActiveWorkbook.SaveAs Filename:=Sciezka & "\" & Nazwa

    End Sub


    Dalej jest cos nie tak
  • Pomocny post
    Moderator Programowanie
    Jeśli
    Code:
    Sciezka = "D:\" 
    to
    Code:
    ActiveWorkbook.SaveAs Filename:=Sciezka & Nazwa 
    Zdublowałeś slash'a.
  • Poziom 9  
    Wciąż nie działa :|
  • Moderator Programowanie
    Makro rusza przy zapisywaniu? Jest jakiś komunikat z Nr błedu? Jakiej wersji Excela używasz?
  • Poziom 9  
    Makro nie rusza przy zapisywaniu- nie tworzy się kopia pliku we wskazanej lokalizacji. Wersja Excel Standard Edition 2003. Nie ma żadnych komunikatów. Przy pisaniu też nie ma żadnych błędów. Po prostu nie działa. W załączniku miejsce gdzie makro się znajduje.

    Poniżej jeszcze raz obecny kod

    Code:
    Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
    

    Dim Nazwa As String
    Dim Sciezka As String

    Sciezka = "D:\"
    Nazwa = Format(Now(), "hh.mm.ss_dd.mm.yy") & ".xls"

    ThisWorkbook.Save
    ActiveWorkbook.SaveAs FileName:=Sciezka & Nazwa

    End Sub


    https://obrazki.elektroda.pl/1675055400_1291984487.jpg

    By the way
    Jak można zrobić odniesienie do arkusza o dowolnej nazwie (tak by jakąkolwiek nazwę nosił arkusz makro się nie wysypywało). Normalnie w Excelu (nie w VBA) można użyć "". W VBA niestety nie działa.

    Proszę poprawnie dodawać obrazki, za pomocą przycisku "Dodaj obrazek". Załącznik usunąłem. - arnoldziq[/img]]Link[url=]Link[/url]