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: 64093 Skopiuj do schowka Obsługa błędów
Autor Wiadomość
Gayal
forumowicz


Posty: 20
Wysłany: 10-02-2019, 21:46   Obsługa błędów

Witam
Mam problem z makrem i nie mogę sobie poradzić ,może ktoś na to spojrzy.Problem polega na tym że wyskakują błędy jeżeli na przykład:
1.Przez pomyłkę ktoś naciśnie CANCEL

Kolejną rzeczą są problemy z problemy z polem wyboru a mianowicie
Mam 10 alei i 40 rzędów. Chciałbym "zablokować" makro jeżeli ktoś wybierze nr alei 11 tak aby można było zaczynać od nowa ,to samo tyczy się nr rzędów .
Szczegóły w pliku

Kod:
Sub Mag()
Dim nr_alei As Long
Dim nr_rzedu As Long
Dim magazyn As Range
Dim x As String
Dim y As String

Sheets("Mini magazyn").Activate

y = InputBox("Podaj numer alei")
x = InputBox("Podaj numer rzędu")

On Error GoTo handler1
nr_alei = y * 2 + 2
nr_rzedu = x + 7

If (y > 10) Then
MsgBox "Wybierz inną ", , "Nie ma takiej alei"
End If

If (x > 40) Then
MsgBox "Wybierz inny", , "Nie ma takiego rzędu"
End If

If Cells(nr_alei, nr_rzedu).Value <> "" Then

MsgBox "Miejsce jest zajęte. Wybierz inne"

Else

Set magazyn = Worksheets("Mini magazyn").Cells(nr_alei, nr_rzedu)
Range("Wejścia!p11:p11").Copy
magazyn.PasteSpecial xlPasteValues
Application.CutCopyMode = False

End If

Sheets("Wejścia").Activate

handler1:
Select Case Err.Number
Case 13
MsgBox "Wróć do arkusza Wejścia", , "Ups coś poszło nie tak"
Sheets("Wejścia").Activate
End Select


End Sub

Edit: dm
Proszę stosować znaczniki [code] przy wstawianiu kodów makr, kwerend i formuł, Regulamin 3.1


edycja Zbiniek:
Zmieniłem temat. Pamiętaj, aby temat dostosować do Regulaminu (pkt. 1.4).
Daj znać, jeśli masz inną propozycję.


MM-Adam &#8212; kopia.xlsm
Pobierz Plik ściągnięto 17 raz(y) 46.63 KB

ID posta: 362328 Skopiuj do schowka
 
 
minijack 
Exceloholic


Pomógł: 65 razy
Posty: 180
Wysłany: 11-02-2019, 10:09   

w kwestii alei i rzędów masz tak:
Kod:

If (y > 10) Then
MsgBox "Wybierz inną ", , "Nie ma takiej alei"
End If

ja bym zrobił tak"
Kod:

aleja:
If (y > 10) Then
y = InputBox("Nie ma takiej alei.Wybierz inną:")
goto aleja:
End If
ID posta: 362338 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 202 razy
Posty: 960
Wysłany: 11-02-2019, 10:25   

Gayal napisał/a:
wyskakują błędy jeżeli na przykład:
1.Przez pomyłkę ktoś naciśnie CANCEL

Skorzystaj z:
Kod:
Application.EnableCancelKey = xlDisabled 'Blokuje "Cancel"
Application.EnableCancelKey = xlErrorHandler 'Przekierowuje do pułapki błędów
Application.EnableCancelKey = xlInterrupt 'Odblokowuje "Cancel"

Z alejami i rzędami, można też bez "IF"
Kod:

    Do While y <> 10
        y = InputBox("Podaj numer alei")
    Loop
    Do While x <> 40
        x = InputBox("Podaj numer rzędu")
    Loop
ID posta: 362340 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 2016
Pomógł: 1303 razy
Posty: 4486
Wysłany: 11-02-2019, 11:14   

Ja proponuję pobierać dane w pętli przykładowo tak (przykład dla alei):
Kod:
Sub TestInput()
  Dim y As String
  Dim war As Boolean
  Do
    war = False
    y = InputBox("Podaj numer alei od 1 do 10")
    If y = "" Then Exit Do
    If IsNumeric(y) Then war = CInt(y) >= 1 And CInt(y) <= 10
    If Not war Then MsgBox "Błędny numer alei. Podaj inny"
  Loop Until war
End Sub
Funkcja InputBox zwraca wynik w postaci tekstu. W przypadku naciśnięcia Cancel zwraca tekst pusty. Nie powinno się tego ignorować, tylko przewidzieć w tym przypadku zakończenie pobierania danych (u mnie jest Exit Do, ale może być też Exit Sub lub podstawienie jakiejś wartości domyślnej). Kod sprawdza, czy wprowadzono liczbę i czy mieści się ona w zadanym przedziale. Można jeszcze ewentualnie tę liczbę zaokrąglić, gdyby ktoś wprowadził coś po przecinku.
ID posta: 362344 Skopiuj do schowka
 
 
Gayal
forumowicz


Posty: 20
Wysłany: 11-02-2019, 11:20   

Dzięki za pomoc ,tylko trochę nie rozumiem opcji z naciśnięciem "CANCEL" jeżeli nacisnę 2 razy wyrzuca błąd
ID posta: 362346 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 2016
Pomógł: 1303 razy
Posty: 4486
Wysłany: 11-02-2019, 11:31   

Gayal napisał/a:
nie rozumiem opcji z naciśnięciem "CANCEL" jeżeli nacisnę 2 razy wyrzuca błąd
Miałeś kilka propozycji, nie wiemy do której to pytanie. Nie bardzo można nacisnąć dwa razy, bo program reaguje już na pierwsze naciśnięcie, a drugie odnosi się już do innego miejsca w kodzie.
ID posta: 362348 Skopiuj do schowka
 
 
Gayal
forumowicz


Posty: 20
Wysłany: 11-02-2019, 13:04   

ok rozumiem
ID posta: 362353 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 202 razy
Posty: 960
Wysłany: 11-02-2019, 23:06   

Maciej Gonet napisał/a:

Kod:
    '...
    Do
        war = False
        '...
        If Not war Then .... ... peace ... :) ...
    Loop Until war
    '...

Popieram ... :-> ... "Make peace If Not war" ... ot takie luźne skojarzenie ... :->
ID posta: 362390 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2659 razy
Posty: 8828
Wysłany: 12-02-2019, 04:14   

Panowie, między nie wpisaniem czegokolwiek i zatwierdzeniem OK, a naciśnięciem Cancel (obojętnie czy pusto w polu czy nie) jest różnica. Jeżeli zatwierdzamy OK, a pole jest puste, to znaczy że zatwierdzamy pusty łańcuch. Kiedy naciskamy Cancel, znaczy się, że rezygnujemy z wprowadzania danych.
W tym zadaniu jeżeli ktoś zatwierdzi pusty łańcuch to powinien dostać po łapkach za niewłaściwą wartość. Natomiast jak naciśnie Cancel, to znaczy że rezygnuje z dalszego działania makra. Nie ma chodzenia na skróty. :-)
Makro do testów:
Kod:
Sub TestInputBox()
    Dim s As String
   
    s = InputBox("Wpisz coś lub nic nie wpisuj lub naciśnij Cancel")
   
    If Not CBool(StrPtr(s)) Then
        MsgBox "Wciśnięto Anuluj"
    Else
        MsgBox "wpisano: """ & s & """"
    End If
End Sub


Gayal, moja wizja świata poniżej. Pozwoliłem sobie na małe co nieco. :-)
Kod:
Sub Mag_1()
    Dim x           As String
    Dim y           As String
    Dim nr_alei     As Long
    Dim nr_rzedu    As Long
    Dim rngMiejsce  As Range
    Dim Kolor       As Long


    Worksheets("Mini magazyn").Select

    Do

        Do
            y = InputBox("Podaj numer alei")
            If Not CBool(StrPtr(y)) Then GoTo SubExit
        Loop Until Walidacja(y, 1, 10)

        Do
            x = InputBox("Podaj numer rzędu")
            If Not CBool(StrPtr(x)) Then GoTo SubExit
        Loop Until Walidacja(x, 1, 40)

        'tu jesteśmy pewni prawidłowych, oczekiwanych współrzędnych
        nr_alei = y * 2 + 2
        nr_rzedu = x + 7

        Set rngMiejsce = Worksheets("Mini magazyn").Cells(nr_alei, nr_rzedu)

        If rngMiejsce.Value <> "" Then
            MsgBox "Miejsce jest zajęte. Wybierz inne"
        End If

    Loop Until rngMiejsce.Value = ""

    'tu jesteśmy pewni, że miejsce jest wolne
    rngMiejsce.Value = Worksheets("Wejścia").Range("P11").Value

    'zabawa w kolory
    If rngMiejsce.Interior.ColorIndex = -4142 Then
        Kolor = rngMiejsce.Interior.ColorIndex
    Else
        Kolor = rngMiejsce.Interior.Color
    End If

    rngMiejsce.Interior.Color = 255
    Application.Wait Now + TimeSerial(0, 0, 2)

    If Kolor < 0 Then
        rngMiejsce.Interior.ColorIndex = 0
    Else
        rngMiejsce.Interior.Color = Kolor
    End If

SubExit:
    Worksheets("Wejścia").Select
End Sub


Function Walidacja(strInput As String, lMin As Long, lMax As Long) As Boolean
    On Error Resume Next

    If Not IsNumeric(strInput) Then
        MsgBox "Podaj wartość liczbową!", vbExclamation
        Exit Function
    End If

    If InStr(strInput, ",") > 0 Then
        If CByte(Mid(strInput, Application.Max(InStr(strInput, ","), 1))) > 0 Then
            MsgBox "Nie rób sobie jaj!" & vbLf & _
                   "Podaj liczbę całkowitą.", vbExclamation
            Exit Function
        End If
    End If

    If Int(strInput) <> CDbl(strInput) Then
        MsgBox "Nie rób sobie jaj!" & vbLf & _
               "Podaj liczbę całkowitą.", vbExclamation
        Exit Function
    ElseIf CLng(strInput) < lMin Or CLng(strInput) > lMax Then
        MsgBox "Podaj liczbę całkowitą z zakresu " & lMin & " - " & lMax, vbExclamation
        Exit Function
    Else
        Walidacja = True
    End If

    On Error GoTo 0
End Function

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 362407 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