Lab12

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


Wyszukiwarka

Podobne podstrony:
Lab12 Applications
lab12 1 7
lab12 5 1
LAB12
LAB12 Regulator cyfrowy
lab12 RapidPrototyping EN
Lab12 4 1
12 (2), Elektrotechnika AGH, Semestr II letni 2012-2013, Fizyka II - Laboratorium, laborki, laborki
Lab12 RapidPrototyping
lab12
TECH INT lab12 2014, Studia - Politechnika Opolska, Semestr 6, Techniki Internetowe
LAB12 , Modu˙ sztywno˙ci
lab12 SWBlab12
lab12
lab12 6 3
lab12 4 3
Lab12 RapidPrototyping
Lab12 13spr, PWr, III semestr, MUD
LAB12, TARASIUK

więcej podobnych podstron