Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 68289 Skopiuj do schowka UserForm komunikat warunkowy
Autor Wiadomość
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 04-06-2020, 11:15   UserForm komunikat warunkowy

Witam
Utworzyłem komunikat warunkowy zależny od wartości w komórce "E4".
Uruchamiany powinien być przy zmianie wyboru w komórce "H4"
Wszystko działa, gdy w komórce "H4" jest lista wyboru. gdy wprowadziłem UserForm2, nie działa.
Nie wiem co trzeba zmienić w zapisie.
W załączeniu oba pliki


End Sub

Komunikat UserForm 2020-06-03.rar
plik z listą wyboru
Pobierz Plik ściągnięto 14 raz(y) 100.66 KB

Komunikat UserForm 2020-06-04.rar
plik z wyborem przez UserForm
Pobierz Plik ściągnięto 16 raz(y) 106.89 KB

ID posta: 388320 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 04-06-2020, 11:55   

Coś chyba pomieszałem albo był jakiś problem z moim systemem.

Teraz działa przy różnych zapisach, który jest prawidłowy?
Kod:
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("H4")) Is Nothing And Target.Count = 1 Then
    UserForm3.Show
    End If
    If Not Intersect(Target, Range("H4")) Is Nothing Then
If Range("E4") > 0 Then UserForm2.Show

End If
End Sub

czy ten
Kod:
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("H4")) Is Nothing And Target.Count = 1 Then
    UserForm3.Show
    End If
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("H4")) Is Nothing Then
If Range("E4") > 0 Then UserForm2.Show

End If
En Sub
ID posta: 388324 Skopiuj do schowka
 
 
colpix
Stały bywalec Excelforum


Pomógł: 75 razy
Posty: 261
Wysłany: 04-06-2020, 18:13   

Witam,

skoro działają to obydwa są prawidłowe, ale... ja wybrałbym opcję nr 2, bo efekty działania są różne.

Opcja pierwsza zawarta jest w zdarzeniu
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
gdzie po zaznaczeniu komórki H4 pojawia się UserForm3, gdzie masz przycisk Anuluj, więc się rozmyśliłem, nie wybieram zlecenia tylko daję Anuluj, a tu wyświetla mi UserForm2, bo kod wykonuje się dalej i takie otrzymał zlecenie - po zaznaczeniu komórki H4 wyświetl UserForm3, a następnie UserForm2-gdy spełniony warunek. Tylko po co?

Przy opcji nr 2 przy anulowaniu nie pokazuje się UserForm2, bo jest w zdarzeniu
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
czyli pojawi się dopiero, gdy wybierzemy zlecenie. Wydaje mi się to bardziej sensowne.

Ja zastosowałbym drugi kod i usunąłbym Unload Me z
Kod:
 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
bo to robi przycisk Anuluj, a możesz chcieć sprawdzić kilka zleceń nie uaktywniając każdorazowo UserForm3 - przydałoby się też nadać formom własne nazwy, bardziej intuicyjne i jeszcze inne rzeczy, ale nie o nich teraz mowa.

Wyjdzie w praniu, na razie masz płukanie wstępne.
_________________
Nie jestem leniwy, jestem energooszczędny
Pozdrawiam
colpix
ID posta: 388337 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 04-06-2020, 20:06   

Dziękuję
Zaczynam w końcu to rozumieć. Może zadziałałem za nerwowo. Nazwy oczywiście nadam ale już w pliku roboczym.
Pozdrawiam
ID posta: 388343 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 04-04-2021, 11:00   

Witam
W końcu uporałem się z tym komunikatem, chociaż po drodze zostały wprowadzone inne modyfikacje.
Działa to tak:
Jeżeli w komórce F4 ustawię "zlecenia" to w komórce H4 mam możliwość wyboru zleceń z bazy, gdzie zadany jest termin ważności poszczególnych zleceń.
Jeżeli w komórce E4 pojawi się wartość większa od zera (ilość dni przekroczenia terminu), to wyskoczy komunikat o przekroczeniu terminu z ilością dni przekroczenia. Działa to dobrze ale tylko podczas wybierania zlecenia w komórce H4.

Zdarza się, że plik został zamknięty z wybranym zleceniem i po otwarciu nie ma potrzeby wybierać go jeszcze raz. Jednak aby otrzymać informację o przekroczeniu terminu (jeżeli to nastąpiło) to muszę zlecenie powtórnie wybrać. Dobrze byłoby gdyby w takim przypadku komunikat dodatkowo ukazywał się przy otwieraniu pliku, żeby nie przeoczyć przekroczonego terminu. Podstawowa praca odbywa się w arkuszu specyfikacja.
Poniżej fragment kodu dla arkusza specyfikacja


Kod:
ElseIf Not Intersect(Target, Range("P8:S8,P9:S9,P10:S10,H2:L2,H4:L4,U2:W2")) Is Nothing Then

        With Frm_Kl
            Select Case Target.Address(0, 0)
                Case "P8:S8"
                    .Caption = "Kl_prostokątne"
                    Set .rngZakres = Worksheets("nazwy1").Range("F2:F25")
                Case "P9:S9"
                    .Caption = "Kl kołowe"
                    Set .rngZakres = Worksheets("nazwy1").Range("D30:D43")
                Case "P10:S10"
                    .Caption = "Kl osprzęt"
                    Set .rngZakres = Worksheets("nazwy1").Range("F30:F43")
                Case "H2:L2"
                    .Caption = "Odbiorcy"
                    .cmdCancel.BackColor = &HFF&
                    .cmdCancel.ForeColor = &H8000000E
                    .cmdCancel.Width = 138
                    .TextBox1.Width = 138
                    .ListBox1.Width = 138
                    Set .rngZakres = Worksheets("odbiorcy").Range("H2:H1001")
                    .Width = 208.5
                Case "H4:L4"
                    .Caption = "Zlecenia"
                    '.cmdCancel.BackColor = &HFF&
                    .cmdCancel.Width = 225
                    .TextBox1.Width = 225
                    .ListBox1.Width = 225
                     Set .rngZakres = Worksheets("zlecenia").Range("A2:A201")
                     .Width = 294
                Case "U2:W2"
                     .Caption = "Pracownicy"
                     .cmdCancel.BackColor = &HFFC0C0
                     Set .rngZakres = Worksheets("nazwy1").Range("F46:F64")
                End Select

                    .cmdCancel.Cancel = True
                    .Show
            End With

    If Not Intersect(Target, Range("H4")) Is Nothing Then
        If Range("E4") > 0 Then PT.Show
        End If


Będę wdzięczny za wskazówki.
W załączeniu plik standardowy oraz drugi z wybranym zleceniem.
Pozdrawiam

komunikat 2021-03-04.xlsm
Plik przed wybraniem zlecenia
Pobierz Plik ściągnięto 7 raz(y) 499.6 KB

komunikat 2021-03-04 a.xlsm
Plik po wybraniu zlecenia
Pobierz Plik ściągnięto 5 raz(y) 499.82 KB

  
ID posta: 403168 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 3138 razy
Posty: 10389
Wysłany: 06-04-2021, 01:08   

W module ThisWorkbook:
Kod:
Private Sub Workbook_Open()
    Powitanie.Show vbModeless
    'Calculate
    'Application.Calculation = xlAutomatic
    'Application.Calculation = xlManual
    Application.OnTime Now + TimeSerial(0, 0, 3), "CloseWelcome"

    If ActiveSheet.CodeName = "Arkusz4" Then
        Call Workbook_SheetActivate(Arkusz4)
    End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Arkusz4" Then
        If Sh.Range("E4") > 0 Then
            PT.Show
        End If
    End If
End Sub
ORAZ w module standardowym, np. Module1:
Kod:
Sub CloseWelcome()
    If IsFormExists("Powitanie") Then
        Unload Powitanie
    End If
End Sub


Function IsFormExists(FormName As String) As Boolean
    Dim frm         As Object

    For Each frm In VBA.UserForms
        If UCase(frm.Name) = UCase(FormName) Then
            IsFormExists = True
            Exit For
        End If
    Next frm

End Function

Artik
_________________
Persistence is a virtue in the world of programming.
  
ID posta: 403215 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 06-04-2021, 10:09   

Dziękuję
Pozdrawiam
ID posta: 403229 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 14-04-2021, 14:18   

Witam
Zastosowałem się do wskazówek i komunikaty działają rewelacyjnie. Dziękuję.
Podczas dalszej pracy natknąłem się na inny problem.
W plikach z komunikatem obliczane są ceny („Ceny koł U”, „Ceny koł”, Ceny osprz koł”, Ceny osprz prost”). Pliki oraz pli „Cennik Irmark” te umieszcza się w katalogu „Ceny do Cennika”.
W pliku „Cennik Irmark wchodzimy w zakładkę „Moje menu” na wstążce i za pomocą ikony „Generuj ceny” (hasło „xxx”) przenosimy ceny od arkusza „ceny” w pliku „Cennik Irmark”.
Kod:
Kod:
Sub Kopiowanie_Ceny()

   Call Ceny_Odkryj_Haslo
   
    Application.ScreenUpdating = False
        Application.DisplayAlerts = False
            Application.AskToUpdateLinks = False
               
                With ThisWorkbook
                    If .Name <> "Cennik Irmark.xlsm" Then Exit Sub
                    If Right(.Path, Len(.Path) - InStrRev(.Path, "\", -1, 1)) <> "Ceny do Cennika" Then Exit Sub
                    Workbooks.Open Filename:=.Path & "\Ceny koł U.xlsm", UpdateLinks:=0, ReadOnly:=True
                    Workbooks.Open Filename:=.Path & "\Ceny koł.xlsm", UpdateLinks:=0, ReadOnly:=True
                    Workbooks.Open Filename:=.Path & "\Ceny osprz koł.xlsm", UpdateLinks:=0, ReadOnly:=True
                    Workbooks.Open Filename:=.Path & "\Ceny osprz prost.xlsm", UpdateLinks:=0, ReadOnly:=True
                End With
               
                With Workbooks("Cennik Irmark.xlsm")
               
                    With .Sheets("Ceny").Range("T3764:T5265")
                        .Value = Workbooks("Ceny koł U.xlsm").Sheets("Specyfikacja").Range("T178:T1679").Value
                    End With
                    With .Sheets("Ceny").Range("T17:T1639")
                        .Value = Workbooks("Ceny koł.xlsm").Sheets("Specyfikacja").Range("T57:T1679").Value
                    End With
                    With .Sheets("Ceny").Range("T3010:T3756")
                        .Value = Workbooks("Ceny osprz koł.xlsm").Sheets("Specyfikacja").Range("T64:T810").Value
                    End With
                    With .Sheets("Ceny").Range("T4:T6")
                        .Value = Workbooks("Ceny osprz prost.xlsm").Sheets("Specyfikacja").Range("V45:V47").Value
                    End With
                    With .Sheets("Ceny").Range("T7:T9")
                        .Value = Workbooks("Ceny osprz prost.xlsm").Sheets("Specyfikacja").Range("V49:V51").Value
                    End With
                    With .Sheets("Ceny").Range("T1647:T3009")
                        .Value = Workbooks("Ceny osprz prost.xlsm").Sheets("Specyfikacja").Range("T64:T1426").Value
                    End With
                   
                    Workbooks("Ceny koł U.xlsm").Close SaveChanges:=False
                    Workbooks("Ceny koł.xlsm").Close SaveChanges:=False
                    Workbooks("Ceny osprz koł.xlsm").Close SaveChanges:=False
                    Workbooks("Ceny osprz prost.xlsm").Close SaveChanges:=False
                   
                    Call Ceny_Ukryj_Haslo
                    .Sheets("Spis treści").Select
                    '.Sheets("Ceny").Select
                End With
                           
            Application.AskToUpdateLinks = True
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
       
End Sub


Po zadziałaniu kodu otwarty powinien być arkusz „spis treści” w pliku „Cennik Irmark” pozostałe arkusze i pliki powinny pozostać zamknięte. Po wygenerowaniu cennika pliki z cenami pozostały otwarte i musiałem je pozamykać. Ponieważ po zastosowaniu tego kodu do komunikatu nie działa to dobrze przeprowadziłem testy.

Test 1. Ceny się przekopiowały ale pliki z cenami pozostały otwarte.
Kod:
Kod:
Private Sub Workbook_Open()
    Powitanie.Show vbModeless
    Application.OnTime Now + TimeSerial(0, 0, 3), "CloseWelcome"

    If ActiveSheet.CodeName = "Arkusz4" Then
        Call Workbook_SheetActivate(Arkusz4)
    End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Arkusz4" Then
        If Sh.Range("E4") > 0 Then
            PT.Show
        End If
    End If
End Sub


Test 2 . Ceny się przekopiowały plik z cenami „Ceny osprz prost” pozostał otwarty, poza tym w czasie działania kodu trzeba było zamykać otwierające się okna powitalne plików z cenami.
Kod:
Kod:
Private Sub Workbook_Open()
    Powitanie.Show 'vbModeless
    Application.OnTime Now + TimeSerial(0, 0, 3), "CloseWelcome"

    If ActiveSheet.CodeName = "Arkusz4" Then
        Call Workbook_SheetActivate(Arkusz4)
    End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Arkusz4" Then
        If Sh.Range("E4") > 0 Then
            PT.Show
        End If
    End If
End Sub


Test 3. Ceny się przekopiowały, wszystkie pliki zamknięte.
Kod:
Kod:
Private Sub Workbook_Open()
    Powitanie.Show vbModeless
End Sub


Test 4 . Ceny się przekopiowały, wszystkie pliki z cenami zamknięte, w czasie działania kodu trzeba było zamykać otwierające się okna powitalne plików z cenami.
Kod:
Kod:
Private Sub Workbook_Open()
    Powitanie.Show 'vbModeless
End Sub


Test 5. Ceny się przekopiowały, wszystkie pliki zamknięte.
Bez kodu

Co trzeba zmienić w kodzie żeby wszystko działało poprawnie.
Będę wdzięczny za wskazówki.
W załączeniu pliki które należy umieścić w katalogu "Ceny do Cennika"

Pozdrawiam

Cennik Irmark.rar
Plik cennika
Pobierz Plik ściągnięto 1 raz(y) 844.14 KB

Ceny koł U.xlsm
plik z cenami
Pobierz Plik ściągnięto 1 raz(y) 580.39 KB

Ceny koł.xlsm
plik z cenami
Pobierz Plik ściągnięto 1 raz(y) 582.75 KB

Ceny osprz koł.xlsm
plik z cenami
Pobierz Plik ściągnięto 1 raz(y) 596.01 KB

Ceny osprz prost.xlsm
plik z cenami
Pobierz Plik ściągnięto 1 raz(y) 760.05 KB

  
ID posta: 403584 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 3138 razy
Posty: 10389
Wysłany: 15-04-2021, 04:11   

Tajemnica tkwi w użyciu właściwości AutomationSecurity obiektu Application. Kiedy spodziewasz się, że otwierane skoroszyty zawierają makra, których nie chciałbyś uruchamiać (bo chcesz tylko pobrać z nich dane) ustawiasz tę właściwość na msoAutomationSecurityForceDisable. Makra są wyłączane tylko w otwieranych plikach. W skoroszycie głównym działają nadal.
Procedura po przeróbce
Kod:
Sub Kopiowanie_Ceny()
    Dim secAutomation As MsoAutomationSecurity

    Call Ceny_Odkryj_Haslo

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        secAutomation = .AutomationSecurity
        .AutomationSecurity = msoAutomationSecurityForceDisable
    End With

    Application.AskToUpdateLinks = False

    With ThisWorkbook
        If .Name <> "Cennik Irmark.xlsm" Then GoTo ProcExit
        If Right(.Path, Len(.Path) - InStrRev(.Path, "\", -1, 1)) <> "Ceny do Cennika" Then GoTo ProcExit

        Workbooks.Open Filename:=.Path & "\Ceny koł U.xlsm", UpdateLinks:=0, ReadOnly:=True
        Workbooks.Open Filename:=.Path & "\Ceny koł.xlsm", UpdateLinks:=0, ReadOnly:=True
        Workbooks.Open Filename:=.Path & "\Ceny osprz koł.xlsm", UpdateLinks:=0, ReadOnly:=True
        Workbooks.Open Filename:=.Path & "\Ceny osprz prost.xlsm", UpdateLinks:=0, ReadOnly:=True
       
        With .Sheets("Ceny")
            With .Range("T3764:T5265")
                .Value = Workbooks("Ceny koł U.xlsm").Sheets("Specyfikacja").Range("T178:T1679").Value
            End With
            With .Range("T17:T1639")
                .Value = Workbooks("Ceny koł.xlsm").Sheets("Specyfikacja").Range("T57:T1679").Value
            End With
            With .Range("T3010:T3756")
                .Value = Workbooks("Ceny osprz koł.xlsm").Sheets("Specyfikacja").Range("T64:T810").Value
            End With
            With .Range("T4:T6")
                .Value = Workbooks("Ceny osprz prost.xlsm").Sheets("Specyfikacja").Range("V45:V47").Value
            End With
            With .Range("T7:T9")
                .Value = Workbooks("Ceny osprz prost.xlsm").Sheets("Specyfikacja").Range("V49:V51").Value
            End With
            With .Range("T1647:T3009")
                .Value = Workbooks("Ceny osprz prost.xlsm").Sheets("Specyfikacja").Range("T64:T1426").Value
            End With
        End With

        Workbooks("Ceny koł U.xlsm").Close SaveChanges:=False
        Workbooks("Ceny koł.xlsm").Close SaveChanges:=False
        Workbooks("Ceny osprz koł.xlsm").Close SaveChanges:=False
        Workbooks("Ceny osprz prost.xlsm").Close SaveChanges:=False

        Call Ceny_Ukryj_Haslo
    End With


ProcExit:
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .AutomationSecurity = secAutomation
    End With

End Sub

Parę uwag.
1. W tej procedurze nie ma sensu wyłączać pytań o aktualizację łączy zewnętrznych w otwieranych plikach (Application.AskToUpdateLinks = False) bo i tak, otwierając każdy ze skoroszytów nie zezwalasz na aktualizację łączy ((...), UpdateLinks:=0,(...))
2. Konstrukcje With...End With można zagnieżdżać co widać w tym fragmencie
Kod:
    With ThisWorkbook
(...)
        With .Sheets("Ceny")
(...)
3. Należy uważać przy wcześniejszym wychodzeniu z procedury z powodu spełnienia się jakiegoś warunku. Przez nieuwagę możesz spowodować, że Excel nie będzie działał później prawidłowo. Chodzi o właściwości obiektu Application, które ustawiasz (często wyłączasz) na początku procedury. Lepiej zamiast Exit Sub użyć GoTo Etykieta (porównaj swój i mój kod).
4. Nie wiem jaki jest cel sprawdzania nazwy skoroszytu oraz zmuszanie, by pliki znajdowały się w ściśle określonym folderze. Ma to coś na swoją obronę?

W module Do_Cennika.
5. Kompilator wrzeszczy, że napisałeś zbyt długą procedurę (Procedure too large). Mniej więcej na środku procedury zakończ ją:
Kod:
(...)
    Call Ceny_do_cennika2
End Sub
, a z reszty kodu utwórz następną procedurę:
Kod:
Sub Ceny_do_cennika2()
6. Nie wiem, czy Ty z Koniakowa pochodzisz ;-) ale to makro wygląda jakbyś dziergał koronkową serwetkę na szydełku. W większym bloku danych coś takiego:
Kod:
    Worksheets("Tr TS wyk II").Range("B14").Value = _
    Worksheets("Ceny").Range("T676").Value
    Worksheets("Tr TS wyk II").Range("C14:C15").Value = _
    Worksheets("Ceny").Range("T677:T678").Value
    Worksheets("Tr TS wyk II").Range("D14:D16").Value = _
    Worksheets("Ceny").Range("T679:T681").Value
jest nieczytelne. Prawie nie widać gdzie tu się zaczyna, a gdzie kończy linia kodu.
A może wyglądać tak:
Kod:
Sub Ceny_do_cennika()
    'Kopiowanie cen do cennika
    Dim wksC        As Worksheet

    Call Cennik_Odkryj_Haslo

    Set wksC = Worksheets("Ceny")

    With Worksheets("Przewody AI")
        .Range("C14:C16").Value = wksC.Range("T4:T6").Value
        .Range("C19:C21").Value = wksC.Range("T7:T9").Value
    End With

    With Worksheets("Czerp-wyrz ścien A")
        .Range("B14:B22").Value = wksC.Range("T1647:T1655").Value
        .Range("C14:C22").Value = wksC.Range("TT1656:T1664").Value
        .Range("D14:D22").Value = wksC.Range("T1665:T1673").Value
        .Range("E14:E22").Value = wksC.Range("T1674:T1682").Value
        .Range("G14:G22").Value = wksC.Range("T1683:T1691").Value
        .Range("H14:H22").Value = wksC.Range("T1692:T1700").Value
        .Range("I14:I22").Value = wksC.Range("TT1701:T1709").Value
        .Range("J14:J22").Value = wksC.Range("T1710:T1718").Value
        .Range("K14:K22").Value = wksC.Range("T1719:T1727").Value
    End With
(...)
Znacznie czytelniejszy i krótszy kod (może nie ilość linii, ale ilość znaków). Jak przerobisz w ten sposób cały kod w module, to może się okaże, że kompilator już zaakceptuje procedurę i nie będziesz musiał jej dzielić na dwie.

Tyle.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 403621 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 15-04-2021, 12:27   

Witam
Dziękuję za cenne uwagi.
Głowa mi się zagotowała.
Mam zbyt mała wiedzę i stąd te pokraczne kody. nie wszystko co stosuje do końca jest dla mnie zrozumiałe. Ale i tak dzięki forum robię postępy patrząc co było rok temu. Zabieram się do pracy i spróbuje to poprawić.
Nie sądzę, że wszystko uda mi się zrozumieć, więc pewnie będę potrzebował jeszcze pomocy.
Na szybko sprawdziłem, że wszystko działa super. Jesteś Mistrzem. Teraz zabieram się za dalszymi poprawkami i upraszczanie kodów wg Twoich uwag.
Pozdrawiam

Ayala
  
ID posta: 403641 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 15-04-2021, 17:19   

Witam ponownie
Męczę si z przerabianiem kodu ale jakoś to idzie.
Mógłbyś bardziej mi rozjaśnić twoja uwagę z pkt. 4:

Cytat:
4. Nie wiem jaki jest cel sprawdzania nazwy skoroszytu oraz zmuszanie, by pliki znajdowały się w ściśle określonym folderze. Ma to coś na swoją obronę?


Nie zależy mi na tym, żeby pliki znajdowały się w konkretnym katalogu, jeżeli nie muszą. Myślałem, że tak powinno być. Co trzeba byłoby zmienić w kodzie, czy może Twoja wersja już to uwzględnia.

Pozdrawiam

Ayala
  
ID posta: 403657 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 3138 razy
Posty: 10389
Wysłany: 16-04-2021, 00:53   

Ayala napisał/a:
Nie zależy mi na tym, żeby pliki znajdowały się w konkretnym katalogu, jeżeli nie muszą.
Skoro nie zależy, to po prostu usuń tę linię kodu i po zawodach. Podobnie z linią, która bada, czy plik główny ma nazwę ściśle określoną. Jeżeli dopuszczasz zmianę nazwy tego pliku na inną, to i ta linia kodu jest zbędna. Ale...
Dotychczasowy kształt makra zakłada (zbyt) optymistycznie, że wszystkie wywoływane pliki znajdują się w tym samym katalogu co plik główny. A jak ich tam nie będzie, albo nie będzie tylko niektórych? Przed próbą otwarcia tych plików powinieneś najpierw zbadać czy istnieją w zakładanej lokalizacji (niech to będzie ten sam folder, w którym jest plik główny). W zasadzie sprawdzenie obecności plików powinieneś przeprowadzić na początku makra i jeśli któregoś z plików brak, to MsgBox o problemie i zakończenie działania makra. Badanie każdego z plików tuż przed jego otwarciem spowoduje, że możesz otrzymać cennik niepełny. Np. brakuje ostatniego z wywoływanych plików. Z wcześniejszych otrzymałeś dane i zostały one zapisane do arkusza. Przy braku ostatniego, nic nie zostanie skopiowane, więc otrzymasz "produkt niepełnowartościowy". Dlatego uważam, że sprawdzenie obecności wszystkich niezbędnych plików powinno być na początku. Czyli na zasadzie: albo wszystko, albo nic.
Poczytaj o funkcji Dir do badania obecności pliku. Na forum znajdziesz wiele przykładów jej stosowania.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 403682 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 16-04-2021, 10:36   

Witam
Dziękuje bardzo za wyjaśnienie.
Zakładałem, że plik z cenami będą w tym samym katalogu co plik główny.
Na szybko sprawdziłem ze zmianą nazwy katalogu i pliku głównego. Pozmieniałem również makro do generowania cennika bez podziału makra. Wszystko działa super. Jeszcze raz dziękuję. Super robota.

Fajnie byłoby jednak dla pewności zastosować sprawdzenie o czym piszesz ale to na razie dla mnie czarna magia. Spróbuje się zagłębić w temat.

A może jeszcze jakiś przykład dla rozjaśnienia, żeby móc chociaż wystartować.

Jeszcze raz bardzo dziękuję i zabieram się do pracy.
Pozdrawiam

Ayala
  
ID posta: 403700 Skopiuj do schowka
 
 
wczesny 
Stały bywalec Excelforum


Wersja: Win Office 2016
Pomógł: 34 razy
Posty: 302
Wysłany: 16-04-2021, 11:47   

Nie wgłębiałem się w cały wątek, ale czy plik istnieje, można sprawdzić poleceniem Dir i obliczyć długość zwróconej wartości:

Kod:

If Len(Dir("c:\twojanazwapliku.xlsx")) = 0 Then
   Msgbox "This file does NOT exist."
Else
   Msgbox "This file does exist."
End If
ID posta: 403704 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 16-04-2021, 11:55   

Super dzięki
Pozdrawiam

Ayala
ID posta: 403706 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe