Elektroda.pl
Elektroda.pl
X
SterControl
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

vb excel - program magazynowy pomoc

kehn 25 Lip 2009 18:32 25712 116
  • #1 25 Lip 2009 18:32
    kehn
    Poziom 12  

    Pytanko jak kodem Visual BASIC w excelu obramować komórkę i scalić kilka?

    0 29
  • SterControl
  • Pomocny post
    #2 25 Lip 2009 20:26
    adamas_nt
    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).

    0
  • SterControl
  • #3 26 Lip 2009 08:46
    kehn
    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??

    0
  • Pomocny post
    #4 26 Lip 2009 10:34
    adamas_nt
    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

    0
  • #5 26 Lip 2009 11:23
    kehn
    Poziom 12  

    :) a coś jaśniej przykłady czy coś bo tak po fachowemu nazywając nic mi to nie mówi:P

    0
  • Pomocny post
    #6 26 Lip 2009 11:43
    adamas_nt
    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

    0
  • #7 26 Lip 2009 12:13
    kehn
    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)..

    0
  • Pomocny post
    #8 26 Lip 2009 12:43
    adamas_nt
    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

    0
  • #9 26 Lip 2009 13:03
    kehn
    Poziom 12  

    a czemu nie pobiera i nie widać wartości t1 i t2 w nowym arkuszu??

    0
  • Pomocny post
    #10 26 Lip 2009 13:40
    adamas_nt
    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

    0
  • #11 27 Lip 2009 09:01
    kehn
    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...

    0
  • Pomocny post
    #12 27 Lip 2009 14:57
    adamas_nt
    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.

    0
  • #16 27 Lip 2009 20:15
    kehn
    Poziom 12  

    teraz nastepne pytanie zadanie:) jak zrobić w comboboxie listę arkuszy do wyboru??

    0
  • Pomocny post
    #17 27 Lip 2009 20:48
    adamas_nt
    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

    0
  • #18 27 Lip 2009 21:39
    kehn
    Poziom 12  

    a jak nie chce żeby jeden z arkuszy nie był na liście??

    0
  • Pomocny post
    #19 27 Lip 2009 21:47
    adamas_nt
    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

    0
  • #20 28 Lip 2009 09:14
    kehn
    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?

    0
  • Pomocny post
    #21 28 Lip 2009 09:29
    adamas_nt
    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

    0
  • #22 28 Lip 2009 10:09
    kehn
    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??

    0
  • Pomocny post
    #23 28 Lip 2009 14:19
    adamas_nt
    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...

    0
  • #24 30 Lip 2009 08:36
    kehn
    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...

    0
  • Pomocny post
    #25 30 Lip 2009 16:11
    adamas_nt
    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...

    0
  • #26 31 Lip 2009 20:18
    kehn
    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!.

    0
  • Pomocny post
    #27 01 Sie 2009 08:49
    adamas_nt
    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.

    0
  • #28 01 Sie 2009 20:32
    kehn
    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....

    0
  • #29 01 Sie 2009 20:38
    kehn
    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.

    0
  • Pomocny post
    #30 01 Sie 2009 21:16
    adamas_nt
    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

    0