Strona główna.doc

Strona główna > Makra VBA > Przykłady > Automatyczne odświeżanie tabeli przestawnej

Strona główna > Baza wiedzy > Tabele przestawne > Automatyczne odświeżanie tabeli przestawnej

Tabele przestawne nie mają (poza odświeżaniem przy otwarciu zeszytu) opcji automatycznego odswieżania wraz ze zmianą danych źródłowych.

Pewnym rozwiązaniem może być zastosowanie kodu VBA zdarzenie uaktywnienia arkusza.

Kod oczywiście umieszczamy w module arkusza w którym znajduje się tabela.

Private Sub Worksheet_Activate()

Dim mysheet As Worksheet
    'definiujemy w którym arkuszu sa dane źródłowe
    Set mysheet = Sheets("Dane")

    Application.ScreenUpdating = False

    'przypisujemy adres zakresu w jakim są dane źródłowe
    '(przy założeniu, że komórka A1 znajduje się w zakresie danych źródłowych)
    myrange = mysheet.Name & "!" & _
    mysheet.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)

    'przypisujemy zakres danych źródłowych tabeli przestawnej
    ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=myrange

    'odświeżamy tabelę przestawną
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

    'ukrywamy paski narzędzi związanych z tabelą przestawną
    ActiveWorkbook.ShowPivotTableFieldList = False
    Application.CommandBars("PivotTable").Visible = False

    Application.ScreenUpdating = True

End Sub

Strona główna > Makra VBA > Przykłady > Cofanie makra

Generalnie wykonanie makra nie umożliwia jego cofnięcia - nie można skorzystać z przycisku 'cofnij'.

Jednakże, odpowiednie napisanie kodu może nam umożliwić cofanie makra.

Poniższy kod jest tylko przykładem z założenia możliwie najprostszym - cofamy tutaj makro zmieniające format liczbowy aktywnej komórki. Działanie na zakresach wielokomórkowych będzie wymagało skorzystania z tablic.

Private oldformat As String

Sub Format()

'zapamiętuje jaki był poprzedni format liczbowy
oldformat = ActiveCell.NumberFormat

'zamienia format liczbowy
ActiveCell.NumberFormat = "#,##0.00"

'przysuje metodzie undo makro przywracające stary format
Application.OnUndo "Cofnij formatowanie", "UndoFormat"

End Sub

Sub UndoFormat()

'wstawia stary format liczbowy
ActiveCell.NumberFormat = oldformat

End Sub

Strona główna > Makra VBA > Przykłady > Dowolny zakres na UserFormie

Rozwinięcie tematu z artykułu wykresnauserformie.htm.

Otóż problem był następujący: czy da się jakimś magicznym sposobem wstawić do UserForma kopię dowolnego zakresu z arkusz?

Odpowiedź jest twierdząca, a zostałą wyszperana na grupie microsoft.public.excel.programming, autor postu rondebruin (at) kabelfoon.nl.

Oto ona:

Sub make_gif_file()
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Set ctoTheChartHolder = ActiveSheet.ChartObjects.Add(0, 0, 800, 600)

    Set chtTheChart = ctoTheChartHolder.Chart

    '   Paste the picture onto the chart and
    '   set an object variable for it
    ctoTheChartHolder.Activate
    With chtTheChart
        .ChartArea.Select
        .Paste
        Set picThePicture = .Pictures(1)
    End With

    '   Set the picture's properties...
    With picThePicture
        .Left = 0
        .Top = 0
        sglWidth = .Width + 7
        sglHeight = .Height + 7
    End With

    '   Change the size of the chart object to fit the picture
    'better
    With ctoTheChartHolder
        .Border.LineStyle = xlNone
        .Width = sglWidth
        .Height = sglHeight
    End With

    '   Which filter to use?..
    strFileExtension = "bmp"

    '   Export the chart as a graphics file
    blnRet = chtTheChart.Export(Filename:="c:\range.gif", _
                                Filtername:="gif", Interactive:=False)
    ctoTheChartHolder.Delete
End Sub

Strona główna > Makra VBA > Przykłady > Drukowanie na inną niż domyślna drukarkę

Jeżeli potrzebujemy wydrukować dokumnet na inną niż domyśłna drukarkę możemy posłużyć się następującym kodem (źródło: http://www.erlandsendata.no):

Sub PrintToAnotherPrinter()

Dim STDprinter As String
 

    STDprinter = Application.ActivePrinter

    'tymczasowa zmiana drukarki
    Application.ActivePrinter = "microsoft fax na fax:" 'nazwa drukarki

    'na którą chcemy wydrukowć dokument
 

    ActiveSheet.PrintOut

    'powrót do poprzedniej drukarki

    Application.ActivePrinter = STDprinter

End Sub

Strona główna > Dla księgowych (ale, nie tylko!) > Export faktur do pliku tekstowego

Strona główna > Makra VBA > Przykłady >  Export faktur do pliku tekstowego

Dział sprzedaży w firmie dostarczającej usługi ciągłe (usługi oczyszczania) przygotowuje miesięczne zestawienie sprzedaży ad hoc, na podstawie którego dział księgowości przygotowuje faktury. Zestawienie ma następujący format:

Zdarzają się miesiące kiedy dział księgowości musi takich faktur przygotować kilkadziesiąt co jednej osobie zajmuje cały dzień pracy.

Lekarstwem okazało się wdrożenie makr VBA, które eksportują zapisy z powyższego zestawienia do pliku tekstowego, który następnie może zostać zaimportowany do programu księgowego. Procedura ta eliminuje konieczność ręcznego wprowadzania faktur, dzięki czemu obecnie wystawienie faktur trwa mniej niż pół godziny.

Dział sprzedaży wstawia w kolumnie 'I' znak, że daną sprzedaż można już zafakturować, Dział księgowości weryfikuje dane zawarte w zestawieniu z posiadaną dokumentacją i w  kolumnie 'J' wstawia znak oznaczający, że dany rekord może zostać wyeksportowany. Makro sprawdza czy w kolumnie 'J' znajduje się litera 'T' lub słowo 'tak' i eksportuje dany rekord, a następnie usuwa znak/znaki z kolumny 'J' w celu uniknięcia pomyłkowego dwukrotnego zafakturowania tej samej sprzedaży.

Sprzedaż jest księgowana analitycznie wg rodzaju i sprzedawcy, ponieważ kody używane w programie księgowym i zestawieniu nie odpowiadają sobie, konieczne było utworzenie w dodatkowym arkuszu odpowiednich słowników:

Makro eksportujące faktury do pliku tekstowego wygląda następująco:

Public komorka As Range
Public zapisztekst As String

Sub eksportFaktur()

Dim eksportrange As Range
Dim licz As Long
 

    'definiuje zakres w którym są 'T'
    Sheets("sprzedaż").Select
    kolumna = Range("eksport").Column
   

    Set eksportrange = Range(Cells(1, kolumna), Cells(5000, kolumna))

    'otwiera plik txt
    sciezka = Range("sciez").Text
    nazwa = "faktury.txt"
    Open sciezka & "\" & nazwa For Output As #1

    'zapisuje faktury do pliku txt
    licz = 0
    For Each komorka In eksportrange
        If komorka.Text = "T" Or komorka.Text = "t" Or komorka.Text = "TAK" _

        Or komorka.Text = "tak" Then
            'tutaj kod eksportu
            Call eksportuj_linie_zam

            komorka.Value = ""
            Print #1, zapisztekst
            licz = licz + 1
        End If
    Next
 

        Close #1

    'wyświetla informację o liczbie wyeksportowanych linii

    info = MsgBox("You have succesfully exported " & licz & " order lines" & _

...