1) W arkuszu zaczynając od komórki A2 wstawić następującą tabelę oraz wypełnić ją wartościami ze znakiem %
(sumy w każdym rzędzie muszą dać 100%):
Pozycja
Całkowicie się
zgadzam
Zgadzam się
Jestem
niezdecydowany Nie zgadzam się
Kategorycznie się nie
zgadzam
Lokalizacja uczelni PO jest dogodna
12%
Istnieje dobry kontakt z dziekanatem
Witryna WWW jest profesjonalna
Pracownicy są życzliwi
Pracownicy są pomocni
Pracownicy mają dużą wiedzę
Oferta dydaktyczna jest wysokiej jakości
Ogólnie jestem zadowolona/y
Poleciłbym PO przyjaciołom
Zaznaczyć dane z tabeli i następnie wstawić nowy arkusz Wykresu. Wykres sformatować podobnie do
zamieszczonego poniżej.
Z poziomu VBA umieścić moduł i wpisać w nim następujące instrukcje:
Option Explicit
Sub ShowChart()
Dim UserRow As Long
UserRow = ActiveCell.Row
If UserRow < 3 Or IsEmpty(Cells(UserRow, 1)) Then
MsgBox "Przemieść kursor do wiersza zawierającego dane."
Exit Sub
End If
CreateChart (UserRow)
UserForm1.Show
End Sub
Sub CreateChart(r)
Dim TempChart As Chart
Dim CatTitles As Range
Dim SrcRange As Range, SourceData As Range
Application.ScreenUpdating = False
Set CatTitles = ActiveSheet.Range("A2:F2")
Set SrcRange = ActiveSheet.Range(Cells(r, 1), Cells(r, 6))
Set SourceData = Union(CatTitles, SrcRange)
' Dodanie wykresu
Set TempChart = Charts.Add
' Konfiguracja wykresu
With TempChart
.ChartType = xlColumnClustered
.SetSourceData Source:=SourceData, PlotBy:=xlRows
.HasLegend = False
.PlotArea.Interior.ColorIndex = xlNone
.Axes(xlValue).MajorGridlines.Delete
.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
.ChartTitle.Font.Size = 14
.ChartTitle.Font.Bold = True
.Axes(xlValue).MaximumScale = 0.6
.Axes(xlCategory).TickLabels.Font.Size = 10
.Axes(xlCategory).TickLabels.Orientation = xlHorizontal
.Location Where:=xlLocationAsObject, Name:="Arkusz1"
End With
' Skorygowanie rozmiaru obiektu ChartObject
With ActiveSheet.ChartObjects(1)
.Width = 300
.Height = 150
.Visible = False
End With
End Sub
Z poziomu VBA wstawić UserForm i umieścić na nim 1*Image i 1*CommandButton. Przypisać Przyciskowi
następującą procedurę:
Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim CurrentChart As Chart
Dim Fname As String
Set CurrentChart = ActiveSheet.ChartObjects(1).Chart
' Zapisanie wykresu w formacie GIF
Fname = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
CurrentChart.Export Filename:=Fname, FilterName:="GIF"
ActiveSheet.ChartObjects(1).Delete
' Wyświetlenie wykresu
Image1.Picture = LoadPicture(Fname)
Application.ScreenUpdating = True
Kill ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
End Sub
Na arkuszu wstawić przycisk spośród formantów formularza i przypisać mu procedurę ShowChart
2) W arkuszu zaczynając od komórki A1 wstawić następującą tabelę
Miesiąc
Sprzedaż
Sty
300
Lut
319
Mar
328
Kwi
346
Maj
356
Cze
365
Lip
374
Sie
385
Wrz
403
Paź
407
Lis
417
Gru
414
Zaznaczyć dane z tabeli i następnie wstawić nowy Wykres. Wykres sformatować podobnie do zamieszczonego
poniżej
Z poziomu VBA wstawić UserForm i umieścić na nim 1*Image i 1*CommandButton i 3*OptionButton. Dla
kontrolek OptionButton zmień właściwość Caption na Liniowy, Powierzchniowy i Słupkowy oraz właściwość
Name odpowiednio na clLine, clPow, clSlup. Przypisz kontrolkom formularza następujące procedury:
Option Explicit
Private Sub UserForm_Initialize()
clSlup.Value = True
End Sub
Private Sub clPow_Click()
Call UpdateChart(xlAreaStacked)
End Sub
Private Sub clSlup_Click()
Call UpdateChart(xlColumnClustered)
End Sub
Private Sub clLine_Click()
Call UpdateChart(xlLineMarkers)
End Sub
Private Sub CommandButton1_Click()
Kill ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
Unload Me
End Sub
Private Sub UpdateChart(chtype)
Dim CurrentChart As Chart
Dim Fname As String
Set CurrentChart = Sheets("Dane").ChartObjects(1).Chart
CurrentChart.ChartType = chtype
' Zapisz wykres jako plik .gif
Fname = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
CurrentChart.Export Filename:=Fname, FilterName:="GIF"
' Pokaż wykres
Image1.Picture = LoadPicture(Fname)
End Sub
Z poziomu VBA umieścić moduł i wpisać w nim następującą procedurę:
Sub ShowChart()
UserForm1.Show
End Sub
Na arkuszu wstawić przycisk spośród formantów formularza i przypisać mu procedurę ShowChart