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.

Excel - makro , zastosowanie do wielu arkuszy.

max1968 04 Jan 2012 10:01 8220 32
  • #1
    max1968
    Level 9  
    Witam, mam problem. Na jednej ze stron znalazłem makro które działa w jednym arkuszu.
    Chciałbym je zastosować do kilku jednakowych arkuszy, nie mam doświadczenia z makrami i dlatego proszę o poradę jak to zrobić.
    Z góry dziękuje.

    Option Explicit

    Dim Zakres As Range


    Private Sub Workbook_Open()

    Call Ustal_zakres

    End Sub



    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim haslo As String

    On Error GoTo Workbook_SheetChange_Error

    Application.EnableEvents = False


    With Sh

    If .Name = ("1") Then
    If Not Zakres Is Nothing Then
    If Not Intersect(Target, Zakres) Is Nothing Then
    haslo = Application.InputBox("Podaj hasło", "Hasło", Type:=2)
    If haslo <> "zosia" Then
    Call MsgBox("Zmiany możesz wprowadzać tylko w ostatnim dniu !""", vbExclamation, "Blokada")
    On Error Resume Next
    Application.Undo
    On Error GoTo 0
    End If

    End If
    End If
    End If
    Call Ustal_zakres
    End With

    Resume_Workbook_SheetChange:

    Application.EnableEvents = True

    On Error GoTo 0
    Exit Sub

    Workbook_SheetChange_Error:

    MsgBox "Błąd " & Err.Number & " (" & Err.Description & ") w procedurze Workbook_SheetChange"
    Resume Resume_Workbook_SheetChange


    End Sub



    Private Sub Ustal_zakres()

    Dim OstW As Long
    Dim NowyM As Byte
    Dim NowyR As Integer
    Dim Tbl As Variant
    Dim x As Long
    Dim WierszBlok As Long

    On Error GoTo Ustal_zakres_Error

    With ThisWorkbook.Worksheets("1")

    OstW = Last(.Columns("C"))
    If OstW < 2 Then Exit Sub

    Do While OstW > 1
    If IsDate(.Range("C" & OstW).Value) Then
    NowyM = VBA.Day(.Range("C" & OstW).Value)
    NowyR = VBA.Year(.Range("C" & OstW).Value)
    Exit Do
    Else
    OstW = OstW - 1
    End If
    Loop

    If NowyM = 0 Or NowyR = 0 Then Exit Sub

    Tbl = .Range("C2:C" & OstW)

    If OstW > 2 Then
    For x = UBound(Tbl) To LBound(Tbl) Step -1
    If NowyM > VBA.Day(CDate(Tbl(x, 1))) Then
    WierszBlok = x + 1
    Exit For
    Else
    If NowyR > VBA.Year(CDate(Tbl(x, 1))) Then
    WierszBlok = x + 1
    Exit For
    End If
    End If
    Next x
    End If

    If WierszBlok > 1 Then
    Set Zakres = .Rows("2:" & WierszBlok)
    End If

    End With

    On Error GoTo 0
    Exit Sub

    Ustal_zakres_Error:

    MsgBox "Błąd " & Err.Number & " (" & Err.Description & ") w procedurze Ustal_zakres"


    End Sub


    Function Last(rng As Excel.Range) As Long



    On Error Resume Next

    Last = rng.Find(What:="*", _
    After:=rng.Cells(1), _
    Lookat:=xlPart, _
    LookIn:=xlFormulas, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious, _
    MatchCase:=False).Row
    On Error GoTo 0

    End Function
    Ethernet jednoparowy (SPE) - rozwiązania w przemyśle. Szkolenie 29.09.2021r. g. 11.00 Zarejestruj się za darmo
  • #2
    adamas_nt
    Moderator of Programming
    Procedura jest warunkowa. Usuń gałąź
    Code:
    If .Name = ("1") Then
    oraz zmień
    Code:
    With ThisWorkbook.Worksheets("1")
    na
    Code:
    With activesheet
    i powinno działać.
  • #3
    max1968
    Level 9  
    Dziekuje, wykasowałem i zamieniłem kody, jednak na innych arkuszach działa dopiero po zamknięciu, potwierdzeniu zapisania zmian i ponownym otwarciu excela :(
  • #4
    adamas_nt
    Moderator of Programming
    Kod w Thisworkbook?
  • #5
    max1968
    Level 9  
    Tak oczywiście , wyskakuje ... Błąd 1004(Method 'Intersect' of object '_Global' failed) w procedurze Workbook_SheetChange
  • #7
    max1968
    Level 9  
    Rozumie, ale nie o to mi chodziło.
    W tym arkuszu bedzie to przedstawione dokładniej.
    Chodzi o to aby tak jak w arkuszu1, po wpisaniu daty w pozostałych arkuszach nie było można dokonywać edycji komórek do danej daty .
    Nie wiem czy jasno się wyrażam :)
  • #8
    max1968
    Level 9  
    Sory, żle to tłumacze :(
    Chodzi o to aby tak jak w arkuszu1, po wpisaniu daty, blokowała się edycja komórek do danej daty.
    To makro działa na jednym arkuszu a chciałbym aby dzialalo na kilku...
  • Helpful post
    #9
    adamas_nt
    Moderator of Programming
    Zmieniłem miejsce wywoływania procedury "Ustal_zakres". Zdaje się, że musi być dla każdego arkusza osobno. Sprawdź, czy działa. Jeśli tak, to można wyrzucić z Workbook_open.
  • #10
    max1968
    Level 9  
    Działa idealnie :):):)
    Dziękuje
    Hmm miałbym jeszcze małe pytanie :)
    Znalazłem na necie takie rozwiązanie " wymuszenie uruchomienia makra" nie wiem czy dobrze to określam :)
    Chodzi o to aby wymusić na pracowniku uruchomienie makra tak aby to od blokady działało.
    Dużo pracy trzeba aby takie makro zrobić ?
    Poprostu moi pracownicy maja swoje arkusze z danymi a ja jedynie ściągam od nich dane, sprawdzam czy jest ok i nie musze się martwić że po kilku tygodniach cos nabałaganią w arkuszach.

    Dodano po 15 [minuty]:

    Dla lepszego zrozumienia ...
    Chodzi o wstawienie poprzedniego makra do tego skoroszytu...
  • #11
    adamas_nt
    Moderator of Programming
    Zapewne chodzi o to, żeby otwarcie bez obsługi makr zablokowało arkusze. Można ukryć arkusze z atrybutem veryhidden, zostawiając jeden z informacją w stylu: "sorry, otwarto bez makr, czy cóś". Ukrywanie realizować przy każdym zamknięciu arkusza, a przy otwarciu odkrywać. Edycję VB ochronić hasłem, żeby nikt nie zmienił atrybutów.

    Edit: O, zdążyłeś wstawić przykład. I właśnie tam jest to zastosowane.
    Raczej makra (oprócz Workbook_Open) ze swojego pliku skopiuj do tego przykładu.
  • #12
    max1968
    Level 9  
    Mniej wiecej rozumie :D jestem laikiem w VB....:)
    Ten arkusz z licencją bardzo mi sie spodobał jednak nie potrafie wkleić tego kodu od Ciebie :(
  • #14
    max1968
    Level 9  
    IDEALNIE !!! super dzięki !!!
    Działa wspaniale :)
  • #15
    walek33
    Level 28  
    wcześniej max1968 wrote:
    Chodzi o to aby wymusić na pracowniku...
    po kilku tygodniach cos nabałaganią w arkuszach

    A wiesz, że pracownik to taki potwór, że jak się uprze to i tak zrobi swoje i potem powie, że "samo się popsuło"? I przeważnie nie lubi być zmuszany do działania na siłę. Wtedy występuje tzw. opór materii i ma się on nijak do prawa Ohma. :D
    a później adamas_nt wrote:
    Edycję VB ochronić hasłem, żeby nikt nie zmienił atrybutów...
    Tajne hasło edycji VBA...

    Dawno nic nie gryzmoliłem więc mnie trochę poniosło (nie złośliwie, w dobrym tego słowa znaczeniu :D ) i lekko prostuję Twój pogląd na cytowany powyżej temat. Dla "umnego" pracownika zabezpieczenie Excela hasłem jest problemem do przejścia w 10 sekund (zależnie od szybkości maszyny do której został dopuszczony) :cry: a polega na uruchomieniu owego starannie zabezpieczonego pliku w OO (czytaj Open Office). Podejrzy wszystko od ukrytych very very veryhidden arkuszy po kod wymalowany w VBA. I w tym momencie miejmy tylko nadzieję, że współpracownicy kolegi max1968 są z tych co wiedzą który guzik nacisnąć "coby się włączyło" i nie czytają elektrody.
    Z noworocznym pozdrowieniem
    W.
  • #16
    max1968
    Level 9  
    :) Moi pracownicy nie są aż tak sprytni :)
    Oczywiście nie obrażając nikogo
    Wiadomo że im więcej zabezpieczeń tym lepiej, ale jak do moich potrzeb takie rozwiązanie jest wystarczające :)
    Wprawdzie znalażłem małą "furtke" w programie bo wykasowując po kolei daty, można dostać się do samego początku wpisu, ale nie wiem czy jest to do usunięcia i pozostaje mi jedynie liczyć na to że się nie domyślą :)
  • #17
    walek33
    Level 28  
    Quote:
    Wprawdzie znalażłem małą "furtke" w programie bo wykasowując po kolei daty, można dostać się do samego początku wpisu, ale nie wiem czy jest to do usunięcia i pozostaje mi jedynie liczyć na to że się nie domyślą

    Próbowałeś blokować zapisaną część arkusza i pozostawiać możliwą do edycji resztę? Pod Excelem zablokowanie częściowe i zabezpieczenie hasłem powinno "prawie skutecznie" uniemożliwić kasowanie danych z komórek.
  • #18
    max1968
    Level 9  
    Narazie tak robię, tzn blokuje im komórki z wcześniejszą datą.
    Niestety jest to bardzo kłopotliwe bo każdy skoroszyt zawiera po 8 do 12 arkuszy narazie to 3 skoroszyty a w przyszłości myśle że będzie więcej :/.
  • #19
    walek33
    Level 28  
    Ależ to wcale nie musi być kłopotliwe. Wystarczy wykorzystać jedno ze zdarzeń arkusza związane z jego aktywacją i w nim:
    - znaleźć ostatni wiersz do zablokowania
    - zaznaczyć blokadę we właściwościach komórki powyżej znalezionego wiersza
    - zablokować arkusz
    Ot cała polityka. Stosując to w pozostałych (w których to konieczne) arkuszach nie musisz nic robić ręcznie. Zadziała automatycznie przy każdej aktywacji arkusza. :D
    Po to jest VBA.
  • #20
    max1968
    Level 9  
    Hmm dziękuje za podpowiedz :)
    Nie jestem orłem w excelu ale spróbuje tego sposobu :)
    Powiem szczerze że tamto makro mi się bardzo podoba bo jeśli chcę coś zmienić osobiście to tylko zmieniam dane wpisuje hasełko i gotowe a przy blokadzie jest troszke więcej pracy...
    W oryginalnym kodzie ( na jednym arkuszu) było tak że nawet jeśli ktoś chciał wykasować date to mógł to zrobić tylko w ostatniej pozycji lub miesiącu ( zależy co było w kodzie, dzień czy miesiąc)
    Po przrobienu na kilka arkuszy niestety już to nie działa.
    Ok próbuje to zablokować jak kolega radzi :)
  • #22
    max1968
    Level 9  
    Witam, próbowałem zrobić zmiany w kodzie ale coś mi nie wychodzi...za cienki bolek jestem :D
    najlepiej to widać na arkuszu montaż...daty są kolejne...
  • #23
    adamas_nt
    Moderator of Programming
    Zmiennej "ostData" w moim przykładzie przypisuję wartość przy uruchamianiu aplikacji.
    Przy zmianie pobierana jest data z ostatniej komórki, czyli... zawsze będzie spełniać warunek.
    Kłopot w tym, że w różnych arkuszach masz różne daty i w różnych kolumnach. Szczęśliwie zawsze w nagłówku jest słowo "Data" i Excel szuka od lewej, więc można by znaleźć kolumnę dla funkcji MAX.

    Jak widzisz jakieś rozwiązanie jest, pytanie czy sprawdzi się w Twoim przypadku.

    Chodzi o to, że jeśli pobierzemy datę Np 12-01-2012, a w arkuszu "Odpady" ostatnia data to 7-01-2012, to czy dane w tym wierszu są do modyfikacji czy już nie...

    Można też pobierać datę przy aktywacji arkusza. Musiałbyś tylko w kodzie każdego wpisać 1-2 linijki kodu...
  • #24
    max1968
    Level 9  
    Hmm coś zaczynam rozumieć...a czy nie można podać daty systemowej ?
    Tzn. aby wszystkie wpisy z datą np dwa dni ( od Dziś() )do tyłu zostały zablokowane ?
    Nie wiem czy mój tok rozumowania jest prawidłowy...
  • #25
    adamas_nt
    Moderator of Programming
    Oczywiście, że można i byłoby tak najprościej. Pozostaje rozwiązanie określenia kolumn z datą w poszczególnych arkuszach. Kod w arkuszach i zmienna globalna, lub szukanie nagłówka przez Cells.Find w procedurze Workbook_SheetChange (znajdzie pierwszą licząc od górnego, lewego narożnika)...
  • #26
    max1968
    Level 9  
    Hmm rozumie .... data rozpoczyna się zawsze w komórce D20 we wszystkich arkuszach...
    Czyli co powinienem zamienić ? bo sam chyba nie dam sobie z tym rady :(
  • #27
    adamas_nt
    Moderator of Programming
    W Workbooks_Open przypisz datę zmiennej. Np
    Code:
    ostData=Date-1 'dla wczorajszej
    W procedurze zdarzeniowej szukaj maksymalnej w 4-tej kolumnie
    Code:
    adam = Application.WorksheetFunction.Max(Columns(4))
    Porównanie (adam < ostData) zdaje się już wpisałeś. Wartość daty dopasuj eksperymentalnie.
  • #28
    walek33
    Level 28  
    A tak przy okazji podpowiem (nie przez upierdliwość :D), że niektóre formuły mogą być prostsze. Precyzując. Tam gdzie masz tablicową sumę z zagnieżdżonym jeżeli dla jednego warunku możesz użyć suma.jeżeli. Też będzie działać.
  • #29
    max1968
    Level 9  
    Napewno można wiele uprościć :) niestety nie mam dużego doświadczenia z excelem :(
    Może z czasem ...:)
    Ale dziekuje za uwagi :) to zawsze pomaga :)
    Niestety wpisałem kody i nic z tego :( nie działa :(
  • #30
    adamas_nt
    Moderator of Programming
    Uruchom makro Private Sub Workbook_Open, lub zamknij plik i otwórz ponownie. Zatrzymanie ręczne makra (przez przycisk resetuj) zeruje wartość zmiennej.