90 likes | 337 Views
Podstawy Visual Basic for Applications (cz. III). 13 I 2014. Podstawy Visual Basic for Applications (cz.III). • automatyczne tworzenie wykresów • automatyczne tworzenie tabel przestawnych • utworzenie aplikacji automatyzującej zarządzanie danymi, arkuszami, skoroszytami z poziomu VBA.
E N D
Podstawy Visual Basic for Applications (cz.III) • • automatyczne tworzenie wykresów • • automatyczne tworzenie tabel przestawnych • utworzenie aplikacji automatyzującejzarządzanie danymi, arkuszami, skoroszytami z poziomu VBA
Jak utworzyć wykres? Utwórz procedurę „UtworzWykres”, która: • Po zaznaczeniu zakresu utworzy na jego podstawie wykres kolumnowy • Zamieści tytuł, tabelkę z wartościami i legendę • Pokaże wartość przy każdym słupku • Pogrubi tytuł wykresu i ustawi wielkość czcionki na 12 • Zmieni rozmiar obiektu Chart na 200 x 300 • Zmieni rozmiar wykresu (Plot) na 150 x 250 • Zakoloruje na tło wykresu na żółto • Wszystkie słupki zabarwi na zielono, z wyjątkiem drugiego, który ma być czerwony • Ustali maksymalną wartość osi pionowej na 0.6
Jak utworzyć wykres? .PlotArea.Height = 250 .PlotArea.Width = 150 .PlotArea.Interior.Color = "yellow" .SeriesCollection(1).Interior.Color = "green" .SeriesCollection(1).Points(2).Interior.Color = "red" .Axes(xlValue).MaximumScale = 0.6 .Deselect End With Application.ScreenUpdating = True End Sub Sub UtworzWykres() Dim zakres As String zakres = Selection.Address Application.ScreenUpdating = False ActiveSheet.Shapes.AddChart.Select With ActiveChart .SetSourceData Range(zakres) 'zakres .ChartType = xlColumnClustered .HasTitle = True .HasDataTable = True .HasLegend = True .ApplyDataLabels Type:=xlDataLabelsShowValue .ChartTitle.Font.Bold = True .ChartTitle.Font.Size = 12 .ChartArea.Height = 300 .ChartArea.Width = 200
Tworzymy szybko takie same wykresy • Przypisz skrót do makra, np. „ctrl+w” • Utwórz wykresy dla danych Polski, Czech, Słowacji i Węgier • Okazuje się, że nie wszystko z tymi wykresami jest w porządku… • Popraw rozmiary obiektu Chart i pola wykresu • Utwórz nową procedurę, która: • dla wszystkich wykresów z arkusza określi te same rozmiary Chart i pola wykresu, co w zaznaczonym (poprawnym) wykresie, • skasuje legendę, tabelkę wartości oraz maksymalną wartość na osi pionowej • zmieni tło na białe • ustawi wykresy jeden pod drugim
Jak zmodyfikować kilka wykresów na raz? • For Each Wykres In ActiveSheet.ChartObjects • With Wykres • .Height = ChartWysokosc • .Width = ChartSzerokosc • .Chart.PlotArea.Height = PlotWysokosc • .Chart.PlotArea.Width = PlotSzerokosc • .Chart.HasLegend = False • .Chart.HasDataTable = False • .Chart.Axes(xlValue).MaximumScale = False • .Top = TopPosition • .Left = LeftPosition • .Chart.PlotArea.Interior.Color = "white" • End With • TopPosition = TopPosition + Wykres.Height • Next Wykres • End Sub Sub RozmiarWyrownanie() Dim ChartSzerokosc As Long, ChartWysokosc As Long Dim PlotSzerokosc As Long, PlotWysokosc As Long Dim TopPosition As Long, LeftPosition As Long Dim Wykres As ChartObject If ActiveChart Is Nothing Then Exit Sub ChartSzerokosc = ActiveChart.Parent.Width ChartWysokosc = ActiveChart.Parent.Height PlotSzerokosc = ActiveChart.PlotArea.Width PlotWysokosc = ActiveChart.PlotArea.Height TopPosition = 1 LeftPosition = 1
Jak utworzyć tabelę przestawną? Sub UtworzTabelePrzestawna() Dim PTCache As PivotCache Dim PT As PivotTable ‘Najpierw utwórzmy wirtualną kopię zakresu danych, która zostanie ulokowana w pamięci podręcznej i nie będzie widoczna nigdzie indziej (czyli tzw. bufor). Dzięki niemu Excel może szybko manipulować tabelą przestawną. Set PTCache = ActiveWorkbook.PivotCaches.Add _ (SourceType:=xlDatabase, SourceData:=Range("A1").CurrentRegion.Address) ‘Następnie utwórzmy szkielet tabeli przestawnej na podstawie bufora Set PT = PTCache.CreatePivotTable _ (TableDestination:="", TableName:="Tabela przestawna1") ‘Wypełnijmy szkielet tabeli przestawnej za pomocą różnych pól w kolumnach, wierszach i wartościach With PT .PivotFields("zmienna").Orientation = xlPageField .PivotFields("kraj").Orientation = xlPageField .PivotFields("rok edycji").Orientation = xlRowField .PivotFields("pora edycji").Orientation = xlRowField .PivotFields("rok prognozy").Orientation = xlColumnField .PivotFields("prognoza").Orientation = xlDataField End With End Sub
Jak zsynchronizować arkusze? ‘Dzięki poniższej procedurze, we wszystkich arkuszach pojawi się to samo zaznaczenie i ta sama aktywna komórka z bieżącego arkusza Sub ZsynchronizujArkusze() Dim BiezacyArkusz As Worksheet, Arkusz As Worksheet Dim Wiersz As Long, Kolumna As Long Dim Zaznaczenie As String Set BiezacyArkusz = ActiveSheet Wiersz = ActiveWindow.ScrollRow Kolumna = ActiveWindow.ScrollColumn Zaznaczenie = ActiveWindow.RangeSelection.Address For Each Arkusz In ActiveWorkbook.Worksheets Arkusz.Activate Range(Zaznaczenie).Select ActiveWindow.ScrollRow = Wiersz ActiveWindow.ScrollColumn = Kolumna Next Arkusz BiezacyArkusz.Activate End Sub
Jak skasować wszystkie wykresy w arkuszu? • W okienko natychmiastowych instrukcji wpisz: ActiveSheet.ChartObjects.Delete …I na koniec kursu: jak zapisać i zamknąć wszystkie skoroszyty (pliki Excela)? • Sub ZamknijWszystkieSkoroszyty() • Dim Skoroszyt As Workbook • For Each Skoroszyt In Workbooks • 'na razie bierzemy pod uwagę wszystkie skoroszyty oprócz bieżącego • If Skoroszyt.Name <> ThisWorkbook.Name Then • Skoroszyt.Close savechanges:=True • End If • Next Skoroszyt • ‘i teraz dopiero możemy zamknąć bieżący skoroszyt, z którego pochodzi makro • ThisWorkbook.Close savechanges:=True • End Sub