Ustvarjanje vrtilnega grafa

Ko človek spozna, da ima preveč datotek s preveč podatki, začne iskat bližnjice. Eno bom opisal v naslednjih vrsticah.

Torej, sledeča koda je bila ustvarjena v VBA (dodatek MS Office) in je namenjena preprostemu risanju kumulativnega grafa padavin za posamezen mesec.

Nekaj je pojasnjeno v komentarjih, za več pa...

Sub dez()

Dim sFile As String

Dim datum, dez, dez_prvi, skupno As Range

'Odpiranje pretvorjene datoteke

sFile = Application.GetOpenFilename(fileFilter:="Excel Files (*.xls), *.xls", _

                                        Title:="Prosim izberi datoteko")

    If sFile = "False" Then Exit Sub

        

Workbooks.Open Filename:=sFile

'prebere ime odprtega zvezka in ga zapise v temp variablo

template_file = ActiveWorkbook.Name

'najde celico ki ima besedilo dež

Range("A:A").Select

Selection.Copy

Workbooks.Add

ActiveSheet.Paste

novi = ActiveWorkbook.Name

Windows(template_file).Activate

Cells.Find(What:="dež", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _

        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

        , SearchFormat:=False).Activate

'izbere cel stolpec, ki vsebuje dež in ga skopira v nov zvezek

ActiveCell.EntireColumn.Select

Selection.Copy

Windows(novi).Activate

Cells(1, 2).Select

ActiveSheet.Paste

'Izdelava vrtilnega grafikona

Sheets.Add

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

        "List1!R1C1:R44632C2", Version:=xlPivotTableVersion12).CreatePivotTable _

        TableDestination:="List2!R1C1", TableName:="Vrtilna tabela1", _

        DefaultVersion:=xlPivotTableVersion12

    Sheets("List2").Select

    Cells(1, 1).Select

    ActiveSheet.Shapes.AddChart.Select

    ActiveChart.SetSourceData Source:=Range("'List2'!$A$1:$C$18")

    ActiveChart.ChartType = xlColumnClustered

    With ActiveSheet.PivotTables("Vrtilna tabela1").PivotFields("Date")

        .Orientation = xlRowField

        .Position = 1

    End With

    ActiveSheet.PivotTables("Vrtilna tabela1").AddDataField ActiveSheet.PivotTables _

        ("Vrtilna tabela1").PivotFields("Dež"), "Vsota od Dež", xlSum

    With ActiveSheet.PivotTables("Vrtilna tabela1").PivotFields("Vsota od Dež")

        .Calculation = xlRunningTotal

    End With

    ActiveChart.SeriesCollection(1).Select

    ActiveSheet.ChartObjects("Grafikon 1").Activate

    ActiveChart.SeriesCollection(1).ChartType = xlLine

'odpre dialog za shranjevanje in pri tem uporabi ime prvotne datotke, samo da dodan koncnico .xls

   fileSaveName = Application.GetSaveAsFilename( _

    InitialFileName:="\\srv\users\danijel\Moji dokumenti\CERO\vreme CERO\2010\pretvorjeno\dez_" + template_file + ".xls", _

    fileFilter:="Excel Files (*.xls), *.xls")

    If fileSaveName = False Then

        Exit Sub

    End If

' Shrani datoteko v format xls

   ActiveWorkbook.SaveAs Filename:= _

        fileSaveName, FileFormat:=xlExcel11, _

        CreateBackup:=False

'    file_name_saved = ActiveWorkbook.FullName

'    MsgBox "Datototeka je shranjena: " & vbCr & vbCr & file_name_saved

Workbooks("dez_" + template_file + ".xls").Close SaveChanges:=True

Windows(template_file).Close

    

End Sub