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.

vb excel - program magazynowy pomoc

25 Lip 2009 18:32 26933 116
  • Poziom 12  
    Pytanko jak kodem Visual BASIC w excelu obramować komórkę i scalić kilka?
  • Pomocny post
    Moderator Programowanie
    Skorzystaj z rejestratora makr... Pisz, jeśli będziesz chciał zrobić coś, czego nie można nagrać (dynamiczne określanie zakresów, działanie warunkowe itp).
  • Poziom 12  
    jestem początkujący z vb ale mam doświadczenie w basic pierwsze moja prace były na commodore :) stare dzieje później amiga...
    pracuje nad zrobieniem magazynu towarów na sklepie chodzi o proste funkcje żeby dodawać do magazynu a następnie odejmować co się sprzedało a przy odejmowaniu tworzył się dzienny raport sprzedaży. w raporcie tym automatycznie obliczany ma być zysk danego dnia...

    chce żeby wszystko działo się za pomocą kodu nie ręcznym wpisywaniu w arkusze...

    teraz przecuje nad wyszukaniem danego kodu towary:
    Option Explicit

    Dim t1, t2
    Private Sub Label2_Click()

    End Sub

    Private Sub TextBox1_Change()
    Dim tekst As String
    Dim Licznik

    tekst = TextBox1.Value


    On Error GoTo etError

    'z wiersza, gdzie w kolumnie A = "b" z kolumny B pobiera "????"
    t1 = WorksheetFunction.VLookup(tekst, Sheets("Magazyn").Range("A1:c31"), 2, 0)
    'i z tego samego wiersz warość z kolumny C
    t2 = WorksheetFunction.VLookup(tekst, Sheets("Magazyn").Range("A1:c31"), 3, 0)
    'pokazanie wyszukania
    Label1.Caption = "Znaleziono kod-> " & tekst & vbCrLf & vbCrLf & "Sztuk w magazynie-> " & t1 & vbCrLf & vbCrLf & "Cena za szt.-> " & t2
    Exit Sub

    etError:
    Label1.Caption = "Nie znaleziono."
    End Sub

    No i jak zrobić żeby wyszukał z kilku arkuszy???

    Dodano po 8 [minuty]:

    jak sie zamyka userform bo chciałem dodać do niego przycisk exit??
  • Pomocny post
    Moderator Programowanie
    Cytat:
    No i jak zrobić żeby wyszukał z kilku arkuszy???
    Zrobiłbym tak:
    Wyszukiwanie i składanie stringu dla etykiety umieściłbym w osobnej funkcji, do której z głównej procedury zdarzeniowej przekazywało by się argumenty: tekst wyszukiwania i nazwa arkusza, a która zwracałaby string dla etykiety. W zależności od tego ile masz magazynów (arkuszy) zastosowałbym przypisanie w pętli lub w kolejności (jeśli nie więcej niż trzy).
    Przypisanie tekstu etykiety realizowałoby się w ten sposób
    Code:
    Label1.Caption = Funkcja(tekst, NazwaArkusza)


    Cytat:
    jak sie zamyka userform bo chciałem dodać do niego przycisk exit??
    Code:
    Unload Nazwa
  • Poziom 12  
    :) a coś jaśniej przykłady czy coś bo tak po fachowemu nazywając nic mi to nie mówi:P
  • Pomocny post
    Moderator Programowanie
    Np coś takiego (pisane z klawiatury, nie testowane)
    Code:
    Private Sub TextBox1_Change()
    
    Dim tekst As String
    tekst = TextBox1.Value

    'wywołanie funkcji z przekazaniem argumentów: kryteria wyszukiwania i nazwa arkusza
    Label1.Caption = TekstEtykiety(tekst, "Magazyn")
    ' Label2.Caption = TekstEtykiety(tekst, "Magazyn2")
    'itd

    End Sub


    Function TekstEtykiety(szukana As String, nazwaArk As String) As String
    Dim t1, t2 ' nie znam typu
    On Error GoTo etError

    'z wiersza, gdzie w kolumnie A = "b" z kolumny B pobiera "????"
    t1 = WorksheetFunction.VLookup(szukana, Sheets(nazwaArk).Range("A1:c31"), 2, 0)
    'i z tego samego wiersz warość z kolumny C
    t2 = WorksheetFunction.VLookup(szukana, Sheets(nazwaArk).Range("A1:c31"), 3, 0)
    'pokazanie wyszukania
    TekstEtykiety = "Znaleziono kod-> " & szukana & vbCrLf & vbCrLf & _
    "Sztuk w magazynie-> " & t1 & vbCrLf & vbCrLf & "Cena za szt.-> " & t2
    Exit Function

    etError:
    TekstEtykiety = "Nie znaleziono."
    End Function
  • Poziom 12  
    zobacz załącznik co wyszło... teraz mnie bardziej zrozumiesz o co mi chodzi i che żeby jak znajdzie wartość w A, x to pobierze dane z B,x i C,x itd które wpisze w nowy raport (arkusz)..
  • Pomocny post
    Moderator Programowanie
    Aaa, to spróbuj
    Code:
    Private Sub TextBox1_Change()
    
    Dim tekst As String, wynik As String

    tekst = TextBox1.Value
    wynik = TekstEtykiety(tekst, "Magazyn")
    If wynik <> "" Then
        Label1.Caption = wynik
    Else
        wynik = TekstEtykiety(tekst, "Magazyn2")
        If wynik <> "" Then
            Label1.Caption = wynik
        Else
            Label1.Caption = "Nie znaleziono."
        End If
    End If

    End Sub


    Function TekstEtykiety(szukana As String, nazwaArk As String) As String
    Dim t1 As String, t2 As Currency
    On Error GoTo etError

    'z wiersza, gdzie w kolumnie A = "b" z kolumny B pobiera "????"
    t1 = WorksheetFunction.VLookup(szukana, Sheets(nazwaArk).Range("A1:c31"), 2, 0)
    'i z tego samego wiersz warość z kolumny C
    t2 = WorksheetFunction.VLookup(szukana, Sheets(nazwaArk).Range("A1:c31"), 3, 0)
    'pokazanie wyszukania
    TekstEtykiety = "Znaleziono kod-> " & szukana & vbCrLf & vbCrLf & _
    "Sztuk w magazynie-> " & t1 & vbCrLf & vbCrLf & "Cena za szt.-> " & Format(t2, "0.00zł")
    Exit Function

    etError:
    TekstEtykiety = ""
    End Function

    Jeśli magazynów przewidujesz więcej to Collection i pętla: For Each Arkusze in Kolekcja
  • Poziom 12  
    a czemu nie pobiera i nie widać wartości t1 i t2 w nowym arkuszu??
  • Pomocny post
    Moderator Programowanie
    Przeanalizuj ten fragment (2 arkusze)
    Code:
    tekst = TextBox1.Value
    
    wynik = TekstEtykiety(tekst, "Magazyn")
    If wynik <> "" Then
        Label1.Caption = wynik
    Else
        wynik = TekstEtykiety(tekst, "Magazyn2")
        If wynik <> "" Then
            Label1.Caption = wynik
        Else
            Label1.Caption = "Nie znaleziono."
        End If
    End If
    i porównaj z tym (3 arkusze)
    Code:
    tekst = TextBox1.Value
    
    wynik = TekstEtykiety(tekst, "Magazyn")
    If wynik <> "" Then
        Label1.Caption = wynik
    Else
        wynik = TekstEtykiety(tekst, "Magazyn2")
        If wynik <> "" Then
            Label1.Caption = wynik
        Else
            wynik = TekstEtykiety(tekst, "Magazyn3")
            If wynik <> "" Then
                Label1.Caption = wynik
            Else
                Label1.Caption = "Nie znaleziono."
            End If
        End If
    End If

    i z prostą pętlą zakładając, że wszystkie arkusze (ile by ich nie było) są magazynami. Tu możesz dodawać i usuwać arkusze do woli.
    Code:
    Dim i As Integer
    
    tekst = TextBox1.Value
    For i = 1 To ThisWorkbook.Worksheets.Count
    wynik = TekstEtykiety(tekst, Sheets(i).Name)
        If wynik <> "" Then Exit For
        wynik = "Nie znaleziono."
    Next

    Label1.Caption = wynik
  • Poziom 12  
    ok czaje ale mam inny problem:
    Code:
    Private Sub TextBox1_Change()
    
    Dim tekst As String, wynik As String

    tekst = TextBox1.Value
    wynik = TekstEtykiety(tekst, "Magazyn")
    If wynik <> "" Then
        Label1.Caption = wynik
    Else
        wynik = TekstEtykiety(tekst, "Magazyn2")
        If wynik <> "" Then
            Label1.Caption = wynik
        Else
            Label1.Caption = "Nie znaleziono."
        End If
    End If

    End Sub


    Function TekstEtykiety(szukana As String, nazwaArk As String) As String

    On Error GoTo etError

    'z wiersza, gdzie w kolumnie A = "b" z kolumny B pobiera "????"
    t1 = WorksheetFunction.VLookup(szukana, Sheets(nazwaArk).Range("A1:c31"), 2, 0)
    'i z tego samego wiersz warość z kolumny C
    t2 = WorksheetFunction.VLookup(szukana, Sheets(nazwaArk).Range("A1:c31"), 3, 0)
    'pokazanie wyszukania
    TekstEtykiety = "Znaleziono kod-> " & szukana & vbCrLf & vbCrLf & _
    "Sztuk w magazynie-> " & t1 & vbCrLf & vbCrLf & "Cena za szt.-> " & t2
    Exit Function

    etError:
    TekstEtykiety = ""
    End Function
    Private Sub UserForm_Initialize()
    Dim i, k
    k = 5
    For i = 1 To k
    ComboBox1.AddItem i 'ListIndex = 0
    Next i

    ComboBox1.Style = fmStyleDropDownList

    ComboBox1.BoundColumn = 0

    ComboBox1.ListIndex = 0

    End Sub

    Teraz jak zrobić żeby listing w ComboBox był do liczby ile jest w magazynie wyszukanego kodu czyli t1??

    Dodano po 1 [minuty]:

    Code:
    Private Sub UserForm_Initialize()
    
    Dim i
    For i = 1 To t1
    ComboBox1.AddItem i 'ListIndex = 0
    Next i

    ComboBox1.Style = fmStyleDropDownList

    ComboBox1.BoundColumn = 0

    ComboBox1.ListIndex = 0

    End Sub

    tak nie działa wyskakuje błąd...
  • Pomocny post
    Moderator Programowanie
    Przy otwarciu formularza t1 ma wartość Null i stąd błąd. Wartość t1 obliczana jest w funkcji TekstEtykiety i tam wklej pętlę dodawania do listy (gdzieś za linią kodu przypisania t1).Np
    Code:
    t1 = WorksheetFunction.VLookup(szukana, Sheets(nazwaArk).Range("A1:c31"), 2, 0)
    
    UserForm1.ComboBox1.Clear
    For i = 1 To t1
        UserForm1.ComboBox1.AddItem i 'ListIndex = 0
    Next i
    'i z tego samego wiersz warość z kolumny C
    Natomiast właściwości ComboBoxa możesz ustawić w okienku lub przy otwarciu formy.
  • Poziom 12  
    teraz nastepne pytanie zadanie:) jak zrobić w comboboxie listę arkuszy do wyboru??
  • Pomocny post
    Moderator Programowanie
    No nie przesadzaj, drogą dedukcji :)
    Code:
    Private Sub UserForm_Initialize()
    
    For i = 1 To ThisWorkbook.Worksheets.Count
        ComboBoxNazwa.AddItem Sheets(i).Name
    Next
    End Sub
  • Poziom 12  
    a jak nie chce żeby jeden z arkuszy nie był na liście??
  • Pomocny post
    Moderator Programowanie
    Hmm
    Code:
    Private Sub UserForm_Initialize()
    
    For i = 1 To ThisWorkbook.Worksheets.Count
        If Sheets(i).name <> "NazwaArkusza" Then 'wykluczenie
            ComboBoxNazwa.AddItem Sheets(i).Name
        End If
    Next
    End Sub
  • Poziom 12  
    a jak zrobić żeby dodawał na listę arkusze których nazwa zaczyna sie zawsze od M-nazwa, m-nazwa, itd a wszystkie inne nie widział na liste?
  • Pomocny post
    Moderator Programowanie
    Zaczynam się czuć jak uczeń przy tablicy :)
    Code:
    Private Sub UserForm_Initialize()
    
    For i = 1 To ThisWorkbook.Worksheets.Count
        If Left(LCase(Sheets(i).Name), 1) = "m" Then
            ComboBoxNazwa.AddItem Sheets(i).Name
        End If
    Next
    End Sub
  • Poziom 12  
    Sorki ale jestes mi bardzo pomocny:) dziekuję ja tym sposobem sie ucze :)
    odbijesz sobie i mi zrobisz egzamin:) A powiedz ile juz z vb cudujesz??
  • Pomocny post
    Moderator Programowanie
    Cytat:
    i mi zrobisz egzamin
    Żebyś mnie znielubił?
    Cytat:
    ile juz z vb cudujesz??
    Ładnych kilka lat z duuuużą przerwą. Lewitacja kodem VB nie działa (błąd 16), ale :idea: gdyby tak wodę w wino...
  • Poziom 12  
    [quote="adamas_nt"]
    Cytat:
    Żebyś mnie znielubił?

    Nie no fajnie jest sie sprawdzić z vb:) Ale ty to pewnie wymyślisz takie zadanie że hohohoho....

    i teraz kontynuacja pytań:) jak zrobic zeby pokazywał sie blad gdy w text box jest litera, litera z liczba lub liczb. ma byc trylko liczba i tez bez przecinkow...
  • Pomocny post
    Moderator Programowanie
    Tu Link jest opisane. Należałoby tylko uzupełnić w sprawdzanie, czy liczba całkowita Np
    Code:
    If IsNumeric(UserForm1.TextBox1) = False Or UserForm1.TextBox1 - Fix(UserForm1.TextBox1) <> 0 Then
    Po polsku: jeśli wartość pola nie jest liczbą lub liczba po przecinku nie jest zerem, to krzycz, że źle...
  • Poziom 12  
    zobacz co zrobiłem działa tylko utwórz->nowy magazyn i Dodaj->towar do magazynu.
    juz sie zamotałem w tym wpisaniu wszystkich wartości z userform6 do wybranego wczesniej arkusza. chciałbym żeby po naduszeniu dodaj polecenia to jesli jest jakies puste pole to wyskoczy komunikat blędu. natomiast jest jescze kilka innych warunkow do spełnienia. mianowicie ilość sztuk musi byc podana w liczbach całkowitych jesli zdarzy sie inaczej rownierz wyskoczy komunikat błędu. cena zakupu ma mieć max 2 miejsca po przecunku w razie inaczej jak wyżej, no i reszta tak jak na to opis wskazuje... dodam ze jest 1 optionbox który w zależności od rodzaju zaznaczenia ma wpływ na wpis do magazynu.
    no i ostatni textbox cena sprzedazy lu marża. te pola mają być wypęłnione tylko jedno z nich jeśli inaczej kom. Błąd!.
  • Pomocny post
    Moderator Programowanie
    Całkiem fajnie Ci to wychodzi.
    Trochę poprawiłem (na ile zdążyłem dzisiejszego ranka) UserForm6 uwzględniając warunkowanie, o które prosiłeś.

    Natomiast procedura wpisywania do magazynu (teraz wysypana) jest do przerobienia. Moim zdaniem wszystko należy policzyć w polach tekstowych formularza i dopiero przypisać do komórek arkusza. I na końcu JEDNA procedura tworząca obramowania :)

    Napisz też jakimi cenami (ja zakładam, że Brutto) operujesz w arkuszu (magazynie). A może wpisywać obie... No i czy przewidujesz inne stawki VAT poza 22%?

    Teraz wyjeżdżam i wracam ok 18:00. Jeśli stworzysz coś nowego, to wrzuć na forum. Ja dołączę wieczorem. Miłego dnia.
  • Poziom 12  
    Dzieki za pochwałę.... Do tego programu można dodać jeszcze dużo....
    zrobi sie po trochu:)
    zrobiłem trochę porządek ale jutro zajmę się wpisaniem do arkusza...

    Świetnie poprawiłeś super!!! teraz trzeba zrobić żeby zamiast ceny nie bylo można wpisywać liter....
  • Poziom 12  
    a i jeszcze bo pytałeś w magazyn ma być wpisane brutto tak jak sie domyśliłeś :) innych stawek vat nie przewiduje a jak bedzie potrzeba to sie dorobi...
    Jeszcze wytłumacze ci ten kod poczatkowy to kod litery. np jak wpiszesz "P" to do magazynu bedzie wpisywana wartość P1, nastepny towar pod P2 idt.
  • Pomocny post
    Moderator Programowanie
    Zerknij do załącznika... Cena zakupu i sprzedaży jest obliczana i przypisywana do zmiennych przy zdarzeniach w formularzu (patrz etykiety). Przetestuj, daj znać.

    Edit: Obejrzałem wynik Twoich "porządków" w kodzie i jakoś mam wrażenie, że idziemy tym samym torem :)

    Edit niedziela 8:15: Zmieniłem załącznik