background image

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")

background image

    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

background image

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"

background image

    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