I
Ivica Lopar
This code should put pivot table and chart on sheet ("Izvjestaj")but he does
not put chart and run time error "438" object doesn t support this property
or metod
in this line
ActiveWorkbook.Names("Podaci").Delete
I do not now what is the problem maybe in declarations "Dim brojredova as
long".
Help me please!
Sub Kreiraj()
Dim Dizv, Prod, Izv, Pt As Object
Dim Izvor As Range
Dim Dan, Mjesec, Godina As Integer
Dim Datum_p, Datum_zav As Date
Dim NoviRed As Long
Dim brojredova As Long
Set Prod = Worksheets("Prodaja")
Prod.Cells(1, 1).CurrentRegion.Name = "Podaci"
Prod.Columns(1).Name = "DATUM"
Set Dizv = DialogSheets("DialogIzvjestaj")
Set Izv = Worksheets("Izvjestaj")
If Izv.ProtectContents = True Then
Izv.Unprotect
End If
Izv.Cells.Delete
If Dizv.OptionButtons(1).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsDate(Dizv.EditBoxes(1).Text) Then
Dan = CDate(Dizv.EditBoxes(1).Text)
Else
MsgBox prompt:="Datum nije ispravno unesen", Buttons:=vbExclamation
Exit Sub
End If
Else
Dan = Date
End If
Prod.Cells(1, 10).Value = "DATUM"
Prod.Cells(2, 10).Value = Dan
Prod.Range("J1:J2").Name = "Kriterij"
'add caption in worksheet Izvjestaj
Izv.Cells(1, 2).Value = "DNEVNI IZVJESTAJ "
Izv.Cells(2, 2).Value = "Dne:" & Dan
ElseIf Dizv.OptionButtons(2).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsDate(Dizv.EditBoxes(1).Text) Then
Datum_p = CDate(Dizv.EditBoxes(1).Text) - _
Weekday(CDate(Dizv.EditBoxes(1).Text)) + 2
Else
MsgBox prompt:="Datum nije ispravno unesen", Buttons:=vbExclamation
Exit Sub
End If
Else
Datum_p = Date - Weekday(Date) + 2
End If
Datum_zav = Datum_p + 7
Prod.Cells(1, 10).Value = "DATUM"
Prod.Cells(1, 11).Value = "DATUM"
Prod.Cells(2, 10).Value = ">=" & Datum_p
Prod.Cells(2, 11).Value = "<=" & Datum_zav
Prod.Range("J1:K2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 2).Value = "TJEDNI IZVJESTAJ"
Izv.Cells(2, 2).Value = Datum_p & " - " & Datum_zav
ElseIf Dizv.OptionButtons(3).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsDate(Dizv.EditBoxes(1).Text) Then
Mjesec = Month(CDate(Dizv.EditBoxes(1).Text))
Godina = Year(CDate(Dizv.EditBoxes(1).Text))
Else
MsgBox prompt:="Mjesc nije ispravno unesen", Buttons:=vbExclamation
Exit Sub
End If
Else
Mjesec = Month(Date)
Godina = Year(Date)
End If
Prod.Cells(1, 10).Value = "MJESEC"
Prod.Cells(2, 10).Formula = "=AND(MONTH(DATUM)= " & Mjesec & "YEAR(DATUM)="
& Godina & ")"
Prod.Range("J1:J2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 2).Value = "MJESECNI IZVJESTAJ"
Izv.Cells(2, 2).Value = "Mjesec:" & Mjesec & "/" & Godina
ElseIf Dizv.OptionButtons(4).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsNumeric(Dizv.EditBoxes(1).Text) Then
Godina = Dizv.EditBoxes(1).Text
Else
MsgBox prompt:="Godina nije ispravno unesena", Buttons:=vbExclamation
Exit Sub
End If
Else
Godina = Year(Date)
End If
Prod.Cells(1, 10).Value = "GODINA"
Prod.Cells(2, 10).Formula = "=YEAR(DATUM)=" & Godina
Prod.Range("J1:J2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 10).Value = "GODISNJI IZVJESTAJ"
Izv.Cells(2, 2).Value = "Godina: " & Godina
Else
If Dizv.EditBoxes(2).Text <> "" And Dizv.EditBoxes(3).Text <> "" Then
If IsDate(Dizv.EditBoxes(2).Text) And IsDate(Dizv.EditBoxes(3).Text) Then
Datum_p = CDate(Dizv.EditBoxes(2).Text)
Datum_zav = CDate(Dizv.EditBoxes(3).Text)
Else
MsgBox prompt:="Datumi nisu ispravno uneseni", Buttons:=vbExclamation
Exit Sub
End If
Else
MsgBox prompt:="Nedostaju podaci o razdoblju", Buttons:=vbExclamation
Exit Sub
End If
Prod.Cells(1, 10).Value = "DATUM"
Prod.Cells(1, 11).Value = "DATUM"
Prod.Cells(2, 10).Value = ">=" & Datum_p
Prod.Cells(2, 11).Value = "<=" & Datum_zav
Prod.Range("J1:K2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 2).Value = "IZVJESTAJ ZA RAZDOBLJE"
Izv.Cells(2, 2).Value = Datum_p & " - " & Datum_zav
End If
NoviRed = Prod.Cells(1, 1).CurrentRegion.Rows.Count + 2
Range("Podaci").AdvancedFilter action:=xlFilterCopy, _
criteriaRange:=Range("Kriterij"), copyToRange:=Prod.Cells(NoviRed, 1)
On Error GoTo LErr
Set Pt = Prod.PivotTableWizard(SourceType:=xlDatabase, _
SourceData:=Prod.Cells(NoviRed, 1).CurrentRegion, _
tableDestination:=Izv.Cells(5, 1), HasAutoFormat:=True)
Pt.AddFields RowFields:="KNJIGA"
Pt.PivotFields("UKUPNO").Orientation = xlDataField
Pt.PivotFields("KOMADA").Orientation = xlDataField
Pt.PivotFields("Data").Orientation = xlColumnField
Pt.PivotFields("Data").Name = "REZULTATI PRODAJE"
Pt.PivotFields("Sum of UKUPNO").NumberFormat = "#,##0.00"
Pt.PivotFields("Sum of UKUPNO").Name = "Iznos prodaje (kn)"
Pt.PivotFields("Sum of KOMADA").Name = "Broj prodanih knjiga"
Izv.Cells(1, 2).Font.Name = "HRHelvbold"
Izv.Cells(1, 2).Font.Size = 18
Izv.Cells(1, 2).Font.Bold = True
Izv.Cells(7, 1).CurrentRegion.AutoFormat Format:=xlClassic2
ActiveWorkbook.Names("Podaci").Delete
Prod.Cells(NoviRed, 1).CurrentRegion.Delete
If Dizv.ChekBoxes(1).Value = xlOn Then
brojredova = Izv.Cells(7, 1).CurrentRegion.Rows.Count
Set Izvor = Izv.Cells(7, 1).Resize(brojredova - 3, 2)
Izv.ChartObjects.Add(0, (brojredova + 8) * 12, 350, 220).Select
ActiveChart.ChartWizard Source:=Izvor, Gallery:=xlColumn, _
Format:=6, PlotBy:=xlColumns, CategoryLabels:=1, _
SeriesLabels:=0, HasLegend:=2, Title:="Pregled prodaje", _
ValueTitle:="Iznos prodaje (kn)", ExtraTitle:=""
End If
Izv.Protect
izlaz = True
Exit Sub
LErr:
MsgBox prompt:="Nema podataka za odabrano razdoblje", _
Buttons:=vbExclamation
ActiveWorkbook.Names("Podaci").Delete
Prod.Cells(NoviRed, 1).CurrentRegion.Delete
End Sub
not put chart and run time error "438" object doesn t support this property
or metod
in this line
ActiveWorkbook.Names("Podaci").Delete
I do not now what is the problem maybe in declarations "Dim brojredova as
long".
Help me please!
Sub Kreiraj()
Dim Dizv, Prod, Izv, Pt As Object
Dim Izvor As Range
Dim Dan, Mjesec, Godina As Integer
Dim Datum_p, Datum_zav As Date
Dim NoviRed As Long
Dim brojredova As Long
Set Prod = Worksheets("Prodaja")
Prod.Cells(1, 1).CurrentRegion.Name = "Podaci"
Prod.Columns(1).Name = "DATUM"
Set Dizv = DialogSheets("DialogIzvjestaj")
Set Izv = Worksheets("Izvjestaj")
If Izv.ProtectContents = True Then
Izv.Unprotect
End If
Izv.Cells.Delete
If Dizv.OptionButtons(1).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsDate(Dizv.EditBoxes(1).Text) Then
Dan = CDate(Dizv.EditBoxes(1).Text)
Else
MsgBox prompt:="Datum nije ispravno unesen", Buttons:=vbExclamation
Exit Sub
End If
Else
Dan = Date
End If
Prod.Cells(1, 10).Value = "DATUM"
Prod.Cells(2, 10).Value = Dan
Prod.Range("J1:J2").Name = "Kriterij"
'add caption in worksheet Izvjestaj
Izv.Cells(1, 2).Value = "DNEVNI IZVJESTAJ "
Izv.Cells(2, 2).Value = "Dne:" & Dan
ElseIf Dizv.OptionButtons(2).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsDate(Dizv.EditBoxes(1).Text) Then
Datum_p = CDate(Dizv.EditBoxes(1).Text) - _
Weekday(CDate(Dizv.EditBoxes(1).Text)) + 2
Else
MsgBox prompt:="Datum nije ispravno unesen", Buttons:=vbExclamation
Exit Sub
End If
Else
Datum_p = Date - Weekday(Date) + 2
End If
Datum_zav = Datum_p + 7
Prod.Cells(1, 10).Value = "DATUM"
Prod.Cells(1, 11).Value = "DATUM"
Prod.Cells(2, 10).Value = ">=" & Datum_p
Prod.Cells(2, 11).Value = "<=" & Datum_zav
Prod.Range("J1:K2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 2).Value = "TJEDNI IZVJESTAJ"
Izv.Cells(2, 2).Value = Datum_p & " - " & Datum_zav
ElseIf Dizv.OptionButtons(3).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsDate(Dizv.EditBoxes(1).Text) Then
Mjesec = Month(CDate(Dizv.EditBoxes(1).Text))
Godina = Year(CDate(Dizv.EditBoxes(1).Text))
Else
MsgBox prompt:="Mjesc nije ispravno unesen", Buttons:=vbExclamation
Exit Sub
End If
Else
Mjesec = Month(Date)
Godina = Year(Date)
End If
Prod.Cells(1, 10).Value = "MJESEC"
Prod.Cells(2, 10).Formula = "=AND(MONTH(DATUM)= " & Mjesec & "YEAR(DATUM)="
& Godina & ")"
Prod.Range("J1:J2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 2).Value = "MJESECNI IZVJESTAJ"
Izv.Cells(2, 2).Value = "Mjesec:" & Mjesec & "/" & Godina
ElseIf Dizv.OptionButtons(4).Value = xlOn Then
If Dizv.EditBoxes(1).Text <> "" Then
If IsNumeric(Dizv.EditBoxes(1).Text) Then
Godina = Dizv.EditBoxes(1).Text
Else
MsgBox prompt:="Godina nije ispravno unesena", Buttons:=vbExclamation
Exit Sub
End If
Else
Godina = Year(Date)
End If
Prod.Cells(1, 10).Value = "GODINA"
Prod.Cells(2, 10).Formula = "=YEAR(DATUM)=" & Godina
Prod.Range("J1:J2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 10).Value = "GODISNJI IZVJESTAJ"
Izv.Cells(2, 2).Value = "Godina: " & Godina
Else
If Dizv.EditBoxes(2).Text <> "" And Dizv.EditBoxes(3).Text <> "" Then
If IsDate(Dizv.EditBoxes(2).Text) And IsDate(Dizv.EditBoxes(3).Text) Then
Datum_p = CDate(Dizv.EditBoxes(2).Text)
Datum_zav = CDate(Dizv.EditBoxes(3).Text)
Else
MsgBox prompt:="Datumi nisu ispravno uneseni", Buttons:=vbExclamation
Exit Sub
End If
Else
MsgBox prompt:="Nedostaju podaci o razdoblju", Buttons:=vbExclamation
Exit Sub
End If
Prod.Cells(1, 10).Value = "DATUM"
Prod.Cells(1, 11).Value = "DATUM"
Prod.Cells(2, 10).Value = ">=" & Datum_p
Prod.Cells(2, 11).Value = "<=" & Datum_zav
Prod.Range("J1:K2").Name = "Kriterij"
'upisivanje naslova u radnu tablicu Izvjestaj
Izv.Cells(1, 2).Value = "IZVJESTAJ ZA RAZDOBLJE"
Izv.Cells(2, 2).Value = Datum_p & " - " & Datum_zav
End If
NoviRed = Prod.Cells(1, 1).CurrentRegion.Rows.Count + 2
Range("Podaci").AdvancedFilter action:=xlFilterCopy, _
criteriaRange:=Range("Kriterij"), copyToRange:=Prod.Cells(NoviRed, 1)
On Error GoTo LErr
Set Pt = Prod.PivotTableWizard(SourceType:=xlDatabase, _
SourceData:=Prod.Cells(NoviRed, 1).CurrentRegion, _
tableDestination:=Izv.Cells(5, 1), HasAutoFormat:=True)
Pt.AddFields RowFields:="KNJIGA"
Pt.PivotFields("UKUPNO").Orientation = xlDataField
Pt.PivotFields("KOMADA").Orientation = xlDataField
Pt.PivotFields("Data").Orientation = xlColumnField
Pt.PivotFields("Data").Name = "REZULTATI PRODAJE"
Pt.PivotFields("Sum of UKUPNO").NumberFormat = "#,##0.00"
Pt.PivotFields("Sum of UKUPNO").Name = "Iznos prodaje (kn)"
Pt.PivotFields("Sum of KOMADA").Name = "Broj prodanih knjiga"
Izv.Cells(1, 2).Font.Name = "HRHelvbold"
Izv.Cells(1, 2).Font.Size = 18
Izv.Cells(1, 2).Font.Bold = True
Izv.Cells(7, 1).CurrentRegion.AutoFormat Format:=xlClassic2
ActiveWorkbook.Names("Podaci").Delete
Prod.Cells(NoviRed, 1).CurrentRegion.Delete
If Dizv.ChekBoxes(1).Value = xlOn Then
brojredova = Izv.Cells(7, 1).CurrentRegion.Rows.Count
Set Izvor = Izv.Cells(7, 1).Resize(brojredova - 3, 2)
Izv.ChartObjects.Add(0, (brojredova + 8) * 12, 350, 220).Select
ActiveChart.ChartWizard Source:=Izvor, Gallery:=xlColumn, _
Format:=6, PlotBy:=xlColumns, CategoryLabels:=1, _
SeriesLabels:=0, HasLegend:=2, Title:="Pregled prodaje", _
ValueTitle:="Iznos prodaje (kn)", ExtraTitle:=""
End If
Izv.Protect
izlaz = True
Exit Sub
LErr:
MsgBox prompt:="Nema podataka za odabrano razdoblje", _
Buttons:=vbExclamation
ActiveWorkbook.Names("Podaci").Delete
Prod.Cells(NoviRed, 1).CurrentRegion.Delete
End Sub