Elektroda.pl
Elektroda.pl
X

Search our partners

Find the latest content on electronic components. Datasheets.com
Elektroda.pl
Please add exception to AdBlock for elektroda.pl.
If you watch the ads, you support portal and users.

[Solved] Makro Excel - Makro zapisujące plik z nazwą z danej komórki, które kopiuje zazna

kocur877 12 Mar 2020 16:36 1383 23
  • #1
    kocur877
    Level 3  
    Witam,
    Mam pytanko do wszystkich fachowców z Excela, jak powinno wyglądać makro które stworzy mi kolejny plik, i skopiuje do niego dane które mam obecnie zaznaczone, dobrze by było aby w pliku głównym stworzyło mi również hiperłącze do nowego pliku, tak aby w razie ewentualnej edycji danych zmieniły się one również w pliku który powstał podczas owego zapisu. Zakres kopiowanych danych będzie się ciągle zmieniał dlatego mam z tym spory problem. Nagranie makra, które kopiuje jakiś konkretny obszar danych to nie jest problem ale mi się ten zakres zmienia i to jest już dla mnie nie do przejścia. Proszę was pomóżcie mi to ogarnąć.
    Ethernet jednoparowy (SPE) - rozwiązania w przemyśle. Szkolenie 29.09.2021r. g. 11.00 Zarejestruj się za darmo
  • #2
    PRL
    Level 39  
    Zdecyduj się czy chcesz kopiować, czy chcesz umieszczać łącza.
    Proponuję nagrać makro i dostosować je do potrzeb.
    Jak już będziesz miał makro, a będziesz potrzebował pomocy, to wrócisz do tematu.:)
  • #3
    kocur877
    Level 3  
    A czy jedno wyklucza drugie ? Bo wydaje mi się że nie, ale ja się nie znam :)
  • #5
    kocur877
    Level 3  
    nagrałem takie makro które otwiera nowy skoroszyt, kopiuje zawartość całego pliku do nowego skoroszytu, usuwa niepotrzebne dane, zapisuje nowy skoroszyt pod nazwą którą sam wpisałem, zamyka nowy plik, wraca do pliku pierwotnego i tworzy w nim hiperłącze do pliku który właśnie zapisałem. I teraz potrzebowałbym aby nazwa pliku zapisywanego była brana z konkretnej komórki z pliku pierwotnego oraz aby hiperłącze też było stworzone do pliku który właśnie się zapisał. Da się tak ?
    Tu wklejam nagrane makro:
    Cells.Select
    Range("K3").Activate
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("B21:E21").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("G21:V21").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll ToRight:=3
    Range("AB17:AB18").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll ToRight:=-14
    Range("B17:V20").Select
    With Selection.Validation
    .Delete
    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
    :=xlBetween
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
    End With
    ChDir "C:\Users\Wioletta Kampe\Desktop\zlecenia"
    ActiveWorkbook.SaveAs Filename:= _
    "C:\Users\Wioletta Kampe\Desktop\zlecenia\21.xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Range("A22").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    "https://mandam-my.sharepoint.com/personal/mistrz_mandam_com_pl/Documents/21.xlsx?web=1" _
    , TextToDisplay:="21"
    End Sub
  • Helpful post
    #6
    PRL
    Level 39  
    Code: vbscript
    Log in, to see the code
  • #7
    kocur877
    Level 3  
    wszystko działa pięknie poza tym łączem, scieżkę musiałem zmienić i problem ma z wybraniem konkretnego pliku do którego ma przypisać łącze bo w miejscu gdzie ma znajdować się już sama nazwa konkretnego pliku wyświetla zmienną "p" i nie potrafi otworzyć linku.
    Range("A15").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    "C:\Users\Wioletta Kampe\Desktop\zlecenia\& p &.xlsx", TextToDisplay:= _
    "ZLECENIE PRODUKCYJNE"
    End Sub
    to jest końcówka makra i tam jest jakiś błąd tylko nie wiem jaki, dodam że makro działa do końca czyli tworzy link.
  • Helpful post
    #8
    PRL
    Level 39  
    Dlaczego usunąłeś Environ? Tak jest uniwersalnie.

    Code: vbscript
    Log in, to see the code
  • #9
    kocur877
    Level 3  
    musiałem to przeoczyć teraz działa idealnie :) ale mam jeszcze jedno zagadnienie, mianowicie chodzi o to, że po tym jak excel wykona te wszystkie czynności to plik z którego robiliśmy kopie zapisujemy jako (w nazwie podajemy dokładnie tą samą wartość co w pliku który makro tworzy samo, czyli ta sama komórka) i później link działa ale wyświetla komunikat że nie można zaktualizować pewnie dlatego że dla hiperłącza źródłem jest plik wzorcowy przed zapisem. Czyli gdyby makro najpierw zapisało plik wzorcowy "jako" a później stworzyło hiperłącze to wtedy gdybym wprowadził jakieś zmiany w pliku pierwszym to ten drugi zaktualizował by się ?
  • #10
    PRL
    Level 39  
    Nic nie rozumiem z tego, co napisałeś.
  • #11
    kocur877
    Level 3  
    1. Otwieram wzór arkusza ze zleceniem w którym zapisane jest moje makro.
    2. Wypelniam ten wzór w odpowiednie dane.
    3. Uruchamiam makro, które tworzy nowy plik zapisuje je pod nazwą pobraną z odpowiedniej komórki po czym tworzy hiperłącze które łączy nowo stworzony plik z plikiem wzorca.
    4. Później aby wzór pozostał wzorem, to plik który wypełniałem zapisuje jako nowy plik bez okrojonej liczby danych. Dzięki temu mój wzór pozostaje wzorem a ja mam dwa pliki ten który sam zapisałem i ten który zapisało mi makro.
    5. Kiedy wchodzę w hiperłącze stworzone przez makro to otwiera mi plik który ma otworzyć ale wyskakuje komunikat, że nie da się aktualizować danych i gdy sprawdzam dlaczego tak się dzieje to widać że źródłem hiperłącza jest ten mój wzór w którym nie ma żadnych danych.
    Pytanie czy gdy jest stworzone hiperłącze to po zmianie danych w jednym pliku jest możliwa automatyczna aktualizacja danych w drugim pliku ?
  • #12
    PRL
    Level 39  
    Zamiast ActiveWorkbook.SaveAs Filename:= _ użyj SaveCopyAs.
  • #13
    kocur877
    Level 3  
    PRL wrote:
    Zamiast ActiveWorkbook.SaveAs Filename:= _ użyj SaveCopyAs.

    gdy wywalam ta linijkę i wpisuje SaveCopyAs. to podświetla mi sie to na czerwono i lipa, czyli cos źle robie tylko nie wiem co :/
  • #14
    PRL
    Level 39  
    Quote:
    ta linijkę

    Możesz pokazać tę linijkę?
  • #15
    kocur877
    Level 3  
    kocur877 wrote:
    PRL wrote:
    Zamiast ActiveWorkbook.SaveAs Filename:= _ użyj SaveCopyAs.

    gdy wywalam ta linijkę i wpisuje SaveCopyAs. to podświetla mi sie to na czerwono i lipa, czyli cos źle robie tylko nie wiem co :/


    End With
    Sciezka = "https://mandam.sharepoint.com/sites/Produkcja/Shared%20Documents/Mistrzowie/Piotrek%20K/Zlecenia Produkcyjne/"
    SaveCopyAs._ tutaj wywaliłem "ActiveWorkbook.SaveAs Filename:= _" i wpisałem SaveCopyAS.
    Sciezka & p & ".xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Range("A15").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Sciezka & p & ".xlsx", _
    TextToDisplay:="ZLECENIE PRODUKCYJNE"
    With Selection.Font
    .Name = "Arial"
    .Size = 16
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleSingle
    .ThemeColor = xlThemeColorHyperlink
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Italic = True
    End Sub
  • #16
    PRL
    Level 39  
    Poproszę linijkę bez komentarza, bo powyższy zapis jest błędny.
  • #17
    kocur877
    Level 3  
    PRL wrote:
    Poproszę linijkę bez komentarza, bo powyższy zapis jest błędny.

    [quote="PRL"]Poproszę linijkę bez komentarza, bo powyższy zapis jest błędny.[/quote
    ok było tak:
    Sciezka = "https://mandam.sharepoint.com/sites/Produkcja/Shared%20Documents/Mistrzowie/Piotrek%20K/Zlecenia Produkcyjne/"
    ActiveWorkbook.SaveAs Filename:= _
    Sciezka & p & ".xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    a ja zrobiłem tak:
    Sciezka = "https://mandam.sharepoint.com/sites/Produkcja/Shared%20Documents/Mistrzowie/Piotrek%20K/Zlecenia Produkcyjne/"
    SaveCopyAs._
    Sciezka & p & ".xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
  • #18
    PRL
    Level 39  
    Code: vbscript
    Log in, to see the code
    [/quote]
  • #19
    kocur877
    Level 3  
    PRL wrote:
    Code: vbscript
    Log in, to see the code
    [/quote]
    zamiast której linijki mam to wstawić bo jak wstawiam zamiast :
    ActiveWorkbook.SaveAs Filename:= _
    to podświetla na czerwono linijkę pod spodem, gdy ją skasuje to niby jest ok ale nie działa.
  • #20
    PRL
    Level 39  
    Wiesz co, Wklej tutaj cały kod, bo widzę, że masz trudności z 1 linijką.
    P.S. Wklej go w znacznikach VBScript.
  • #21
    kocur877
    Level 3  
    PRL wrote:
    Wiesz co, Wklej tutaj cały kod, bo widzę, że masz trudności z 1 linijką.
    P.S. Wklej go w znacznikach VBScript.

    Tak wiem że mam problemy z jedną linijką bo w VBA jestem baaardzo malutki, dlatego proszę o pomoc :) Mój kod:
    Sub Makro()
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("J2").Select
    With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    ActiveCell = ActiveCell.Value
    End With
    Range("J3").Select
    p = [F3]
    Cells.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("N:O").Select
    Selection.Delete Shift:=xlToLeft
    Range("21:21,27:27,33:33").Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Horizontal Scroll 1")).Select
    Selection.Delete
    With Selection.Validation
    .Delete
    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
    :=xlBetween
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
    End With
    Sciezka = "https://mandam.sharepoint.com/sites/Produkcja/Shared%20Documents/Mistrzowie/Piotrek%20K/Zlecenia Produkcyjne/"
    ActiveWorkbook.SaveAs Filename:= _
    Sciezka & p & ".xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Range("A15").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Sciezka & p & ".xlsx", _
    TextToDisplay:="ZLECENIE PRODUKCYJNE"
    With Selection.Font
    .Name = "Arial"
    .Size = 16
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleSingle
    .ThemeColor = xlThemeColorHyperlink
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Italic = True
    End Sub
  • Helpful post
    #22
    PRL
    Level 39  
    Code: vbscript
    Log in, to see the code
  • #23
    kocur877
    Level 3  
    Dzięki bardzo za pomoc i cierpliwość :) jeżeli masz jej jeszcze trochę to napisałem nowy temat z innym problemem dotyczącym makra :)
  • #24
    kocur877
    Level 3  
    Dzięki bardzo za pomoc i cierpliwość :) jeżeli masz jej jeszcze trochę to napisałem nowy temat z innym problemem dotyczącym makra :)