sprzedaz.zip

Excel raport z wykorzystaniem Visual basic'a

Mały arkusz przykładowy masz w załączniku - wykorzystuje proste kopiowanie wierszy w pętli z arkusza źródłowego do docelowego. W pełni zgadzam się z przedmówcą, że tych przycisków coś za dużo - ba, sama idea kopiowania obrazków nie bardzo mi się podoba - wszak masz potem ten sam obrazek w dwóch miejscach... A znając tendencję niektórych ludzi do wklejania zdjęć prosto z aparatu i ich zmniejszania w Excelu (przecież im mniejsze zdjęcie, tym mniej zajmuje miejsca, prawda??)... wiadomo czym to grozi... Przykładowe makro kopiuje całe wiersze, obrazki kopiują się "w standardzie". Kopiowania przycisków w przypisanym im kodem brak - bo o ile można to zrobić, to jest to już bardziej skomplikowane. Lepiej inaczej ten problem rozwiązać - może wystarczy ręcznie wstawić po jednym przycisku na stronie, który dokonuje podsumowania, wyświetlania czy co on tam robi aktualnie zaznaczonej komórki? Nie sprawdzałem prędkości działania dla 1000 wierszy, ale jest to na tyle mała liczba rekordów, że nawet przedstawione średnio wydajne (za to proste :)) rozwiązanie powinno się sprawdzić. Kod: Private Sub CommandButton1_Click() On errorr GoTo myErr Application.ScreenUpdating = False Set wsdane = ThisWorkbook.Worksheets("Dane") Set wsdest = ActiveSheet ost_wiersz = wsdane.Range("A" & wsdane.Rows.Count).End(xlUp).Row wsdest.Cells.Clear 'czyści komórki ze starych danych 'usuwa obrazki For Each s In wsdest.Shapes If s.Type = msoPicture Then s.Delete End If Next s poz = 2 nazwa = UCase(wsdest.Name) wsdane.Rows(1).Copy Destination:=wsdest.Rows(1) 'kopiowanie nagłówka 'kopiowanie wierszy o rodzaju takim, jak nazwa arkusza For i = 2 To ost_wiersz If UCase(wsdane.Cells(i, 1).Value) = nazwa Then wsdane.Rows(i).Copy Destination:=wsdest.Rows(poz) poz = poz + 1 End If Next i 'mały myk na opróżnienie schowka z obrazka wsdane.Range("A1").Copy Application.CutCopyMode = False Set wsdane = Nothing Set wsdest = Nothing Application.ScreenUpdating = True MsgBox "dane skopiowane", vbInformation + vbOKOnly, "Błąd" Exit Sub myErr: Application.ScreenUpdating = True MsgBox Err.Description, vbCritical + vbOKOnly, "Błąd" End Sub

  • sprzedaz.zip
    • sprzedaz.xlsm


Pobierz plik - link do postu