Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Const xlCenter = -4108
- Const xlEdgeLeft = 7
- Const xlContinuous = 1
- Const xlLeft = -4131
- Const xlRight = -4152
- Const xlThick = 4
- Const xlEdgeBottom = 9
- Const xlEdgeTop = 8
- Public Sub createInvoiceFromBusiness(docName As String)
- Dim oExcel As Object
- Dim oDocument As LDE.Document
- Dim oRecord As LDE.Record
- Dim filename As String
- On Error GoTo ErrorHandler
- If ActiveInspector Is Nothing Then Exit Sub
- If ActiveInspector.Class.Name <> "business" Then
- MsgBox "Du måste stå på en affär när du skapar fakturaunderlag!", vbExclamation
- Exit Sub
- End If
- StatusBar.Text = "Skapar fakturaunderlag..."
- StatusBar.Progress = 10
- Set oExcel = CreateObject("Excel.Application")
- oExcel.workbooks.Open WebFolder & "Resources\FaktureringEvent.xltx"
- StatusBar.Progress = 20
- With oExcel.worksheets(1).Columns("B")
- .Replace "$best", ActiveInspector.Record("person.name")
- .Replace "$ftg", ActiveInspector.Record("company.name")
- .Replace "$ref", ActiveInspector.Record("person.name")
- .Replace "$adress", IIf(ActiveInspector.Record("company.invoiceaddress1") = "", ActiveInspector.Record("company.postaladdress1"), ActiveInspector.Record("company.invoiceaddress1"))
- .Replace "$postadress", IIf(Trim(ActiveInspector.Record("company.invoiceaddress1")) = "", Trim(ActiveInspector.Record("company.postalzipcode")) & " " & Trim(ActiveInspector.Record("company.postalcity")), Trim(ActiveInspector.Record("company.invoicezipcode")) & " " & Trim(ActiveInspector.Record("company.invoicecity")))
- .Replace "$datum", Format(Now, "YYYY-MM-DD")
- .Replace "$orgnr", ActiveInspector.Record("company.registrationno")
- End With
- oExcel.Visible = False
- StatusBar.Progress = 30
- filename = ThisApplication.TemporaryFolder & "\" & docName & ".xlsx"
- oExcel.workbooks(1).SaveAs filename
- oExcel.Quit
- StatusBar.Progress = 40
- Set oRecord = New LDE.Record
- Call oRecord.Open(Application.Classes.Item("document"))
- oRecord.Value("comment") = ActiveInspector.Record("name")
- oRecord.Value("type") = "Fakturaunderlag"
- oRecord.Value("coworker") = ActiveUser.Record.id
- oRecord.Value("company") = ActiveInspector.Record("company")
- oRecord.Value("business") = ActiveInspector.Record("idbusiness")
- oRecord.Value("person") = ActiveInspector.Record("person")
- StatusBar.Progress = 50
- Set oDocument = New Document
- oDocument.Load filename
- StatusBar.Progress = 60
- oRecord.Value("document") = oDocument
- oRecord.Document("document").Name = docName
- oRecord.Update
- StatusBar.Progress = 80
- If FileExists(filename) Then
- Kill filename
- End If
- StatusBar.Progress = 100
- Call ThisApplication.OpenDocument(oRecord.Document("document"), lkCheckOutDefault)
- StatusBar.Progress = 0
- StatusBar.Text = ""
- Exit Sub
- ErrorHandler:
- Call UI.ShowError("Reports.createInvoiceFromBusiness")
- End Sub
- Public Sub showIndividualSalesReport()
- Dim startdate As String
- Dim enddate As String
- On Error GoTo ErrorHandler
- If ActiveExplorer.Class.Name <> "coworker" Then
- MsgBox "Du måste stå på medarbetarfliken och välja de medarbetare som skall ingå i rapporten!", vbOKCancel + vbInformation
- Exit Sub
- End If
- startdate = InputBox("Startdatum", "Individuell säljrapport", Format(DateSerial(Year(DateAdd("m", -1, Now)), Month(DateAdd("m", -1, Now)), 1), "YYYY-MM-DD"))
- If startdate = "" Or Not IsDate(startdate) Then Exit Sub
- enddate = InputBox("Slutdatum", "Individuell säljrapport", DateSerial(Year(startdate), Month(startdate) + 1, 0))
- If enddate = "" Or Not IsDate(enddate) Then Exit Sub
- createIndividualSalesReport CDate(startdate), CDate(enddate), ActiveExplorer.Selection.Pool
- Exit Sub
- ErrorHandler:
- Call UI.ShowError("Reports.showIndividualSalesReport")
- End Sub
- Public Sub showSalesReport()
- Dim startdate As String
- Dim enddate As String
- On Error GoTo ErrorHandler
- startdate = InputBox("Startdatum", "Försäljningsrapport GLT", Format(DateSerial(Year(DateAdd("m", -1, Now)), Month(DateAdd("m", -1, Now)), 1), "YYYY-MM-DD"))
- If startdate = "" Or Not IsDate(startdate) Then Exit Sub
- enddate = InputBox("Slutdatum", "Försäljningsrapport GLT", DateSerial(Year(startdate), Month(startdate) + 1, 0))
- If enddate = "" Or Not IsDate(enddate) Then Exit Sub
- createSalesReport CDate(startdate), CDate(enddate)
- Exit Sub
- ErrorHandler:
- Call UI.ShowError("Reports.showSalesReport")
- End Sub
- Private Sub createSalesReport(startdate As Date, enddate As Date)
- Dim oExcel As Object
- Dim oWb As Object
- Dim oWs As Object
- Dim pic As Picture
- Dim oProc As LDE.Procedure
- Dim oParam As LDE.ProcedureParameter
- Dim oFilter As New LDE.Filter
- Dim oView As New LDE.View
- 'Dim recsEventtype As New LDE.Records
- Dim oRec As LDE.Record
- Dim y As Integer
- Dim i As Integer
- Dim rsReportSections As ADODB.Recordset
- Dim eventtypeCount As Integer
- On Error GoTo ErrorHandler
- StatusBar.Text = "Skapar försäljningsrapport..."
- StatusBar.Progress = 10
- '----- Hämta rapportsektioner
- Set rsReportSections = getReportSections
- eventtypeCount = rsReportSections.RecordCount
- ' oFilter.AddCondition "reportsection", lkOpNotEqual, ""
- '
- ' oView.Add "reportsection"
- ' oView.Add "reportorder", lkSortAscending
- '
- ' recsEventtype.Open Database.Classes("eventtype"), oFilter, oView
- '-------
- Set oExcel = CreateObject("Excel.Application")
- oExcel.Visible = False
- Set oWb = oExcel.workbooks.Add
- Set oWs = oWb.Sheets(1)
- oWs.Range("1:1").Font.Size = 22
- oWs.Range("1:1").Font.Bold = True
- oWs.Shapes.AddPicture ThisApplication.WebFolder & "\images\prs_logo.gif", True, True, 400, 5, 140, 40
- StatusBar.Progress = 20
- '---- Rubriker
- oWs.cells(1, 1) = "Försäljningsrapport säljavd " & startdate & " - " & enddate
- oWs.cells(3, 2) = "PERIOD UTFALL"
- oWs.cells(3, 3) = "PERIOD BUDGET"
- oWs.cells(3, 4) = "PERIOD MERFÖRSÄLJNING"
- oWs.cells(3, 5) = "BUDGET VS UTFALL"
- oWs.cells(3, 6) = "PERIOD UTFALL FG ÅR"
- oWs.cells(3, 7) = "UTFALL VS FG ÅR"
- oWs.cells(3, 8) = "YTD UTFALL"
- oWs.cells(3, 9) = "YTD BUDGET"
- oWs.cells(3, 10) = "BUDGET VS UTFALL 2"
- oWs.cells(3, 11) = "YTD UTFALL FG ÅR"
- oWs.cells(3, 12) = "UTFALL VS FG ÅR 2"
- oWs.cells(3, 13) = "YT BUDGET"
- oWs.cells(3, 14) = "YT PROGNOS"
- oWs.cells(3, 15) = "YT PROGNOS VS BUDGET"
- oWs.cells(3, 16) = "YT PROGNOS FG ÅR"
- oWs.cells(3, 17) = "YT PROGNOS FG ÅR VS YT PROGNOS I ÅR"
- oWs.cells(4, 1) = "ANTAL EVENT GLT"
- oWs.cells(5, 1) = "EVENTBESÖKARE GLT"
- '----- Rubriker för rapportavsnitt
- Do While Not rsReportSections.EOF
- i = i + 1
- oWs.cells(6 + i, 1) = rsReportSections("reportsection")
- rsReportSections.MoveNext
- Loop
- oWs.cells(7 + eventtypeCount, 1) = "TOTAL"
- StatusBar.Progress = 30
- '---- Formatera celler
- oWs.Range("B3:Q3").cells.Horizontalalignment = xlCenter
- oWs.Columns("A").ColumnWidth = 20
- oWs.Columns("B:Q").ColumnWidth = 15
- oWs.rows.RowHeight = 20
- oWs.rows(1).RowHeight = 30
- oWs.rows(3).RowHeight = 30
- oWs.Range("A3:Q3").Interior.Color = RGB(234, 235, 234)
- oWs.Range("A3:Q3").Font.Color = RGB(209, 138, 78)
- oWs.Range("A3:Q3").WrapText = True
- oWs.Range("A3:A" & eventtypeCount + 87).Interior.Color = RGB(234, 235, 234)
- oWs.Range("A3:A" & eventtypeCount + 8).Font.Color = RGB(209, 138, 78)
- oWs.Range("A" & eventtypeCount + 8 & ":Q" & eventtypeCount + 8).Interior.Color = RGB(234, 235, 234)
- ' oWs.Range("A" & eventtypecount + 7 & ":Q" & eventtypecount + 7).Font.Color = RGB(209, 138, 78)
- oWs.Range("A6:Q6").Interior.Color = RGB(117, 150, 169)
- StatusBar.Progress = 50
- '---- Värden för rapportavsnitt
- writeSalesSectionToExcel startdate, enddate, 2, oWs, rsReportSections 'period utfall
- writeSalesSectionToExcel DateAdd("yyyy", -1, startdate), DateAdd("yyyy", -1, enddate), 6, oWs, rsReportSections 'period utfall fg år
- StatusBar.Progress = 80
- writeSalesSectionToExcel DateSerial(Year(startdate), 1, 1), enddate, 8, oWs, rsReportSections 'Ytd utfall
- writeSalesSectionToExcel DateAdd("yyyy", -1, startdate), DateAdd("yyyy", -1, DateSerial(Year(enddate), Month(enddate), Day(enddate))), 11, oWs, rsReportSections
- '---- Formler för fältsummering på rad
- For i = 2 To 17
- oWs.Range(Chr(64 + i) & eventtypeCount + 7).formula = "=SUM(" & Chr(64 + i) & "7:" & Chr(64 + i) & 6 + eventtypeCount & ")"
- Next i
- '---- Formler för kolumsummering av rapportavsnitt
- For i = 4 To eventtypeCount + 6
- If i <> 6 Then
- oWs.Range("E" & i).formula = "=B" & i & "-C" & i
- oWs.Range("G" & i).formula = "=B" & i & "-F" & i
- oWs.Range("J" & i).formula = "=H" & i & "-I" & i
- oWs.Range("L" & i).formula = "=H" & i & "-K" & i
- oWs.Range("O" & i).formula = "=M" & i & "-N" & i
- oWs.Range("Q" & i).formula = "=N" & i & "-P" & i
- End If
- Next i
- '--------
- StatusBar.Progress = 100
- oExcel.Visible = True
- StatusBar.Progress = 0
- StatusBar.Text = ""
- Exit Sub
- ErrorHandler:
- StatusBar.Progress = 0
- StatusBar.Text = ""
- Call UI.ShowError("Reports.createIndividualSalesReport")
- End Sub
- Private Sub writeSalesSectionToExcel(startdate As Date, enddate As Date, col As Integer, oWs As Object, rsReportSections As ADODB.Recordset)
- Dim oProc As LDE.Procedure
- Dim oParam As LDE.ProcedureParameter
- Dim y As Integer
- Dim i As Integer
- On Error GoTo ErrorHandler
- If rsReportSections.RecordCount > 0 Then rsReportSections.MoveFirst
- y = 4
- Set oProc = Database.Procedures("csp_getSalesReportdata")
- oProc.Parameters("@startdate").InputValue = startdate
- oProc.Parameters("@enddate").InputValue = enddate
- oProc.Parameters("@rapportsektion").InputValue = ""
- oProc.Execute False
- oWs.cells(y, col) = oProc.Parameters("@antalevent").OutputValue
- oWs.cells(y + 1, col) = oProc.Parameters("@eventbesokare").OutputValue
- oWs.cells(y, col + 1) = oProc.Parameters("@budgeteventcount").OutputValue
- oWs.cells(y + 1, col + 1) = oProc.Parameters("@budgetvisitors").OutputValue
- Do While Not rsReportSections.EOF
- i = i + 1
- oProc.Parameters("@startdate").InputValue = startdate
- oProc.Parameters("@enddate").InputValue = enddate
- oProc.Parameters("@rapportsektion").InputValue = CStr(rsReportSections("reportsection"))
- oProc.Execute False
- oWs.cells(y + 2 + i, col) = oProc.Parameters("@intakt").OutputValue
- oWs.cells(y + 2 + i, col + 1) = oProc.Parameters("@budget").OutputValue
- If col < 4 Then
- oWs.cells(y + 2 + i, col + 2) = oProc.Parameters("@merfors").OutputValue
- End If
- rsReportSections.MoveNext
- Loop
- Exit Sub
- ErrorHandler:
- Call UI.ShowError("Reports.writeSectionToExcel")
- End Sub
- Public Sub createIndividualSalesReport(startdate As Date, enddate As Date, Optional pCoworkers As LDE.Pool)
- Dim oExcel As Object
- Dim oWb As Object
- Dim oWs As Object
- Dim pic As Picture
- Dim oProc As LDE.Procedure
- Dim oParam As LDE.ProcedureParameter
- Dim i As Integer
- Dim n As Integer
- Dim y As Integer
- 'Dim oFilter As New LDE.Filter
- 'Dim oView As New LDE.View
- 'Dim recsEventtype As New LDE.Records
- Dim oRec As LDE.Record
- Dim endCol As String
- Dim rsReportSections As ADODB.Recordset
- Dim moresale As Long
- Dim moresaleotherparks As Long
- On Error GoTo ErrorHandler
- StatusBar.Text = "Skapar indiviuell försäljningsrapport..."
- StatusBar.Progress = 1
- '----- Hämta rapportsektioner
- Set rsReportSections = getReportSections
- '------- Skapa excel-blad
- Set oExcel = CreateObject("Excel.Application")
- Set oWb = oExcel.workbooks.Add
- Set oWs = oWb.Sheets(1)
- oWs.Range("1:1").Font.Size = 22
- oWs.Range("1:1").Font.Bold = True
- oWs.Shapes.AddPicture ThisApplication.WebFolder & "\images\prs_logo.gif", True, True, 239, 5, 140, 40
- '------- Kolumnrubriker
- oWs.cells(1, 1) = "SÄLJRAPPORT " & startdate & " - " & enddate
- oWs.cells(3, 1) = "Säljare"
- oWs.cells(3, 2) = "BESÖKTA KUNDER"
- oWs.cells(3, 3) = "SKICKADE OFFERTER"
- oWs.cells(3, 4) = "BOKADE AFFÄRER"
- '----- Rubriker för rapportavsnitt
- Do While Not rsReportSections.EOF
- i = i + 1
- oWs.cells(3, i + 4) = rsReportSections("reportsection")
- rsReportSections.MoveNext
- Loop
- oWs.cells(3, i + 5) = "MERFÖRSÄLJNING"
- oWs.cells(3, i + 6) = "INTÄKTER PRS"
- endCol = Chr(70 + i)
- '------- Formatera rubriker
- oWs.Range("B3:" & endCol & "3").cells.Horizontalalignment = xlCenter
- oWs.Columns("A:" & endCol).ColumnWidth = 20
- oWs.rows.RowHeight = 20
- oWs.rows(1).RowHeight = 30
- oWs.Range("A3:" & endCol & "3").Interior.Color = RGB(234, 235, 234)
- oWs.Range("A3:" & endCol & "3").Font.Color = RGB(209, 138, 78)
- y = 4
- For i = 0 To pCoworkers.Count - 1
- StatusBar.Progress = Int((i / pCoworkers.Count) * 100)
- '------- Hämta allmänna rapportsiffror ej knutna till rapportsektioner
- Set oProc = Database.Procedures("csp_getIndividualSalesReportdata")
- oProc.Parameters("@idcoworker").InputValue = pCoworkers(i)
- oProc.Parameters("@startdate").InputValue = startdate
- oProc.Parameters("@enddate").InputValue = enddate
- oProc.Parameters("@rapportsektion").InputValue = ""
- oProc.Execute False
- With oWs
- .cells(y, 1) = oProc.Parameters("@name").OutputValue
- .cells(y + 1, 1) = "Summa"
- .cells(y + 2, 1) = "MÅL"
- .cells(y + 3, 1) = "AVVIKELSE"
- .Range("A" & y & ":A" & y).Font.Bold = True
- .Range("A" & y & ":A" & y).Font.Underline = True
- .Range("A" & y & ":" & endCol & y).Interior.Color = RGB(234, 235, 234)
- .Range("A" & y + 2 & ":" & endCol & y + 3).Interior.Color = RGB(237, 208, 184)
- .Range("A" & y + 2 & ":A" & y + 3).Font.Color = RGB(209, 138, 78)
- .Range("A" & y + 2 & ":A" & y + 3).Font.Bold = True
- .Range("A" & y + 1 & ":" & endCol & y + 1).Interior.Color = RGB(131, 186, 150)
- .Range("B" & y + 1 & ":" & endCol & y + 3).cells.Borders(xlEdgeLeft).LineStyle = xlContinuous
- .Range("B" & y + 1 & ":" & endCol & y + 3).cells.Horizontalalignment = xlCenter
- .cells(y + 1, 2) = oProc.Parameters("@customervisits").OutputValue
- .cells(y + 1, 3) = oProc.Parameters("@quotes").OutputValue
- .cells(y + 1, 4) = oProc.Parameters("@bookings").OutputValue
- .cells(y + 2, 2) = oProc.Parameters("@t_customervisits").OutputValue
- moresale = oProc.Parameters("@moresale").OutputValue
- moresaleotherparks = oProc.Parameters("@moresaleotherparks").OutputValue
- '------- Hämta rapportsektionssiffror
- n = 0
- If rsReportSections.RecordCount > 0 Then rsReportSections.MoveFirst
- Do While Not rsReportSections.EOF
- n = n + 1
- oProc.Parameters("@idcoworker").InputValue = pCoworkers(i)
- oProc.Parameters("@startdate").InputValue = startdate
- oProc.Parameters("@enddate").InputValue = enddate
- oProc.Parameters("@rapportsektion").InputValue = CStr(rsReportSections("reportsection"))
- oProc.Execute False
- oWs.cells(y + 1, 4 + n) = oProc.Parameters("@intakt").OutputValue
- oWs.Range(Chr(68 + n) & y + 3).formula = "=-(" & Chr(68 + n) & y + 2 & " - " & Chr(68 + n) & y + 1 & ")"
- rsReportSections.MoveNext
- Loop
- oWs.cells(y + 1, 5 + n) = moresale
- oWs.Range(Chr(69 + n) & y + 3).formula = "=-(" & Chr(69 + n) & y + 2 & " - " & Chr(69 + n) & y + 1 & ")"
- oWs.cells(y + 1, 6 + n) = moresaleotherparks
- oWs.Range(Chr(70 + n) & y + 3).formula = "=-(" & Chr(70 + n) & y + 2 & " - " & Chr(70 + n) & y + 1 & ")"
- '------ Summeringsformel för respektive kolumn
- .Range("B" & y + 3).formula = "=-(B" & y + 2 & " - B" & y + 1 & ")"
- End With
- y = y + 4
- Next i
- StatusBar.Text = ""
- StatusBar.Progress = 0
- oExcel.Visible = True
- Exit Sub
- ErrorHandler:
- Call UI.ShowError("Reports.createIndividualSalesReport")
- End Sub
- Public Function getReportSections() As ADODB.Recordset
- Dim oFilter As New LDE.Filter
- Dim oView As New LDE.View
- Dim recsEventtype As New LDE.Records
- Dim i As Integer
- On Error GoTo ErrorHandler
- oFilter.AddCondition "reportsection", lkOpNotEqual, ""
- oView.Add "reportsection"
- oView.Add "reportorder", lkSortAscending
- recsEventtype.Open Database.Classes("eventtype"), oFilter, oView
- Set getReportSections = New ADODB.Recordset
- getReportSections.Fields.Append "reportsection", adVarChar, 100
- getReportSections.Open
- For i = 1 To recsEventtype.Count
- If getReportSections.RecordCount > 0 Then getReportSections.MoveFirst
- getReportSections.Find "reportsection='" & recsEventtype(i)("reportsection") & "'"
- If getReportSections.EOF Then
- getReportSections.AddNew "reportsection", recsEventtype(i)("reportsection")
- End If
- Next i
- If getReportSections.RecordCount > 0 Then getReportSections.MoveFirst
- Exit Function
- ErrorHandler:
- Call UI.ShowError("Reports.getReportSections")
- End Function
- Public Sub createBusinessList()
- Dim oExcel As Object
- Dim oWb As Object
- Dim oWs As Object
- Dim finished As Boolean
- Dim strYear As String
- Dim dDate As Date
- Dim i As Integer
- Dim oFilter As New LDE.Filter
- Dim oView As New LDE.View
- Dim recs As New LDE.Records
- Dim rec As LDE.Record
- Dim reccount As Integer
- Dim n As Integer
- Dim bookedid As Long
- Dim lastdate As Date
- Dim oProc As LDE.Procedure
- Dim oParam As LDE.ProcedureParameter
- On Error GoTo ErrorHandler
- strYear = InputBox("År", "Affärsöversikt", Year(Now))
- If Not IsNumeric(strYear) Then Exit Sub
- StatusBar.Text = "Skapar affärsöversikt..."
- StatusBar.Progress = 1
- oFilter.AddCondition "park", lkOpEqual, Classes("business").Fields("park").Options.Lookup("glt", lkLookupOptionByKey)
- oFilter.AddCondition "arrivaldate", lkOpGreaterOrEqual, DateSerial(strYear, 1, 1)
- oFilter.AddOperator lkOpAnd
- oFilter.AddCondition "arrivaldate", lkOpLessOrEqual, DateSerial(strYear, 12, 31)
- oFilter.AddOperator lkOpAnd
- oFilter.AddCondition "currentstatus", lkOpEqual, Classes("business").Fields("currentstatus").Options.Lookup("booked", lkLookupOptionByKey)
- oFilter.AddCondition "currentstatus", lkOpEqual, Classes("business").Fields("currentstatus").Options.Lookup("quote", lkLookupOptionByKey)
- oFilter.AddCondition "currentstatus", lkOpEqual, Classes("business").Fields("currentstatus").Options.Lookup("preliminary", lkLookupOptionByKey)
- oFilter.AddOperator lkOpOr
- oFilter.AddOperator lkOpOr
- oFilter.AddOperator lkOpAnd
- oFilter.Name = "Affärslista"
- oView.Add "arrivaldate", lkSortAscending
- oView.Add "eventtime", lkSortAscending
- oView.Add "eventtype"
- oView.Add "name" 'eventnamn
- oView.Add "company" 'företag
- oView.Add "person" 'kontaktperson
- oView.Add "salesperson"
- oView.Add "coworker3"
- oView.Add "numberofparticipants"
- oView.Add "participantsactual"
- oView.Add "total"
- oView.Add "comment"
- oView.Add "currentstatus"
- recs.Open Database.Classes("business"), oFilter, oView
- bookedid = Classes("business").Fields("currentstatus").Options.Lookup("booked", lkLookupOptionByKey)
- '------- Skapa excel-blad
- Set oExcel = CreateObject("Excel.Application")
- Set oWb = oExcel.workbooks.Add
- Set oWs = oWb.Sheets(1)
- oWs.cells(1, 1) = "Datum"
- oWs.cells(1, 2) = "Dag"
- oWs.cells(1, 3) = "Tid"
- oWs.cells(1, 4) = "Lokal"
- oWs.cells(1, 5) = "Aktivitetstyp"
- oWs.cells(1, 6) = "Affärsnamn"
- oWs.cells(1, 7) = "Företag"
- oWs.cells(1, 8) = "Kontakt"
- oWs.cells(1, 9) = "Säljare"
- oWs.cells(1, 10) = "Projektledare"
- oWs.cells(1, 11) = "Kommentar"
- oWs.cells(1, 12) = "Mini antal"
- oWs.cells(1, 13) = "Verkligt antal"
- oWs.cells(1, 14) = "Fakturerat"
- oWs.ListObjects.Add(1, oWs.Range("$A$1:$N$366"), , 1).Name = "Tabell1"
- oWs.ListObjects("Tabell1").TableStyle = "TableStyleMedium2"
- oWs.Range("$A$1:$N$366").Borders.LineStyle = 1
- oWs.Range("$A$1:$A$366").NumberFormat = "[$-sv-SE]dd/mmm;@"
- oWs.Columns.ColumnWidth = 20
- oWs.Columns("A").ColumnWidth = 10
- oWs.Columns("B").ColumnWidth = 10
- oWs.Columns("B").Horizontalalignment = xlRight
- oWs.cells(1, 2).Horizontalalignment = xlLeft
- oWs.Range("A:A").Interior.Color = RGB(47, 117, 181)
- oWs.Range("A1:N1").Interior.Color = RGB(47, 117, 181)
- oWs.Range("A:A").Font.Color = RGB(255, 255, 255)
- oWs.Range("A1:N1").Font.Color = RGB(255, 255, 255)
- oWs.Range("A1:N1").Font.Bold = True
- dDate = DateSerial(strYear, 1, 1)
- i = 2
- Do While Not finished
- oWs.cells(i, 1) = dDate
- oWs.cells(i, 2).formula = "=TEXT(A" & i & ",""ddd"")"
- If Weekday(dDate) = vbMonday And i > 4 Then
- oWs.rows(i).Borders(xlEdgeTop).Weight = xlThick
- End If
- i = i + 1
- dDate = DateAdd("d", 1, dDate)
- If Year(dDate) <> strYear Then finished = True
- Loop
- 'oWs.Range("$B$1:$B$366").NumberFormat = "hh:mm;@"
- i = 1
- reccount = recs.Count
- Set oProc = Database.Procedures("csp_getPlacesForBusiness")
- For Each rec In recs
- n = n + 1
- StatusBar.Progress = Int((n / reccount) * 100)
- If oWs.cells(i, 1) = rec("arrivaldate") Or (oWs.cells(i, 1) = "" And rec("arrivaldate") = lastdate) Then 'Finns redan en affär, skapa ny rad
- oWs.cells(i, 1).offset(1).entirerow.Insert Shift:=-4121
- i = i + 1
- oWs.cells(i, 2).formula = ""
- If i > 366 Then
- oWs.cells(i, 2).formula = "=TEXT(A" & i & "," & Chr(34) & Chr(34) & ")"
- End If
- Else
- While oWs.cells(i, 1) <> rec("arrivaldate") And i < 1000
- i = i + 1
- Wend
- End If
- lastdate = rec("arrivaldate")
- oWs.cells(i, 3) = rec("eventtime")
- oProc.Parameters("@idbusiness") = rec.id
- oProc.Execute False
- oWs.cells(i, 4) = oProc.Parameters("@return").OutputValue
- If Not IsNull(rec("eventtype")) Then oWs.cells(i, 5) = rec("eventtype.eventname")
- If Not IsNull(rec("name")) Then oWs.cells(i, 6) = rec("name")
- If Not IsNull(rec("company")) Then oWs.cells(i, 7) = rec("company.name")
- If Not IsNull(rec("person")) Then oWs.cells(i, 8) = rec("person.name")
- If Not IsNull(rec("salesperson")) Then oWs.cells(i, 9) = rec("salesperson.name")
- If Not IsNull(rec("coworker3")) Then oWs.cells(i, 10) = rec("coworker3.name")
- oWs.cells(i, 11) = rec("comment")
- oWs.cells(i, 12) = rec("numberofparticipants")
- oWs.cells(i, 13) = rec("participantsactual")
- oWs.cells(i, 14) = rec("total")
- If rec("currentstatus") <> bookedid Then
- oWs.rows(i).Font.Italic = True
- oWs.cells(i, 1).Font.Italic = False
- oWs.cells(i, 2).Font.Italic = False
- oWs.cells(i, 11) = "OFFERT/PREL " & rec("comment")
- End If
- Next
- oExcel.Visible = True
- StatusBar.Text = ""
- StatusBar.Progress = 0
- Exit Sub
- ErrorHandler:
- Call UI.ShowError("Reports.createBusinessList")
- End Sub
- Public Sub dumpFilter(oFilter As LDE.Filter)
- Dim i As Integer
- Dim str As String
- Dim op As OperatorEnum
- On Error Resume Next
- For i = 1 To 11
- str = oFilter.Item(i).field
- str = str & " " & oFilter.Item(i).Operator
- str = str & oFilter.Item(i).Value
- Select Case oFilter.Item(i).Operator
- Case 9
- str = str & " AND"
- Case 1
- str = str & " OR"
- End Select
- Debug.Print str
- Next i
- End Sub
- Public Sub showOverviewCalendar()
- Dim sYear As String
- sYear = InputBox("År", "Visa översiktskalender för events", Year(Now))
- If IsNumeric(sYear) Then
- isDateReserved 1007, DateSerial(CInt(sYear), 1, 1), True
- createOverviewCalendar 1007, sYear
- End If
- End Sub
- Public Function createOverviewCalendar(facility As Long, sYear As String) As Object
- Dim lMonth As Long
- Dim strMonth As String
- Dim rStart As Object
- Dim strAddress As String
- Dim rCell As Object
- Dim lDays As Long
- Dim dDate As Date
- Dim oExcel As Object
- Dim oWb As Object
- Dim oWs As Object
- Set oExcel = CreateObject("Excel.Application")
- Set oWb = oExcel.workbooks.Add
- Set oWs = oWb.Sheets(1)
- 'Add new sheet and format
- 'ActiveWindow.DisplayGridlines = False
- With oWs.cells
- .ColumnWidth = 10#
- .Font.Size = 14
- End With
- 'Create the Month headings
- For lMonth = 1 To 4
- Select Case lMonth
- Case 1
- strMonth = "Januari"
- Set rStart = oWs.Range("A1")
- Case 2
- strMonth = "April"
- Set rStart = oWs.Range("A8")
- Case 3
- strMonth = "Juli"
- Set rStart = oWs.Range("A15")
- Case 4
- strMonth = "Oktober"
- Set rStart = oWs.Range("A22")
- End Select
- 'Merge, AutoFill and align months
- With rStart
- .Value = strMonth
- .Horizontalalignment = xlCenter
- .Interior.colorindex = 6
- .Font.Bold = True
- With .Range("A1:G1")
- .Merge
- .BorderAround LineStyle:=xlContinuous
- End With
- .Range("A1:G1").AutoFill Destination:=.Range("A1:U1")
- End With
- Next lMonth
- 'Pass ranges for months
- For lMonth = 1 To 12
- strAddress = Choose(lMonth, "A2:G7", "H2:N7", "O2:U7", _
- "A9:G14", "H9:N14", "O9:U14", _
- "A16:G21", "H16:N21", "O16:U21", _
- "A23:G28", "H23:N28", "O23:U28")
- lDays = 0
- oWs.Range(strAddress).BorderAround LineStyle:=1
- 'Add dates to month range and format
- For Each rCell In oWs.Range(strAddress)
- lDays = lDays + 1
- dDate = DateSerial(Year(Date), lMonth, lDays)
- If Month(dDate) = lMonth Then ' It's a valid date
- With rCell
- .Value = dDate
- .NumberFormat = "ddd dd"
- If isDateReserved(facility, DateSerial(CInt(sYear), Month(dDate), Day(dDate))) Then
- .Interior.colorindex = 36
- End If
- End With
- End If
- Next rCell
- Next lMonth
- 'add con formatting
- With oWs.Range("A1:U28")
- .FormatConditions.Add Type:=1, Operator:=3, Formula1:="=TODAY()"
- .FormatConditions(1).Font.colorindex = 2
- .FormatConditions(1).Interior.colorindex = 1
- End With
- oWs.Range("A1").entirerow.Insert
- oWs.Range("A1").entirerow.Insert
- oWs.cells(1, 1) = "Översikt"
- oWs.cells(1, 2) = sYear
- oWs.cells(1, 5) = "Event"
- oWs.cells(1, 5).Interior.colorindex = 36
- oExcel.Visible = True
- 'Set CreateCalendar = oExcel
- End Function
- Public Function isDateReserved(facility As Long, dDate As Date, Optional init As Boolean) As Boolean
- Static rsReservations As ADODB.Recordset
- Dim recsReservations As LDE.Records
- Dim recReservation As LDE.Record
- Dim oFilter As New LDE.Filter
- Dim oView As New LDE.View
- If init Then
- Set rsReservations = Nothing
- End If
- If rsReservations Is Nothing Then
- oFilter.AddCondition "facility", lkOpEqual, facility
- oFilter.AddCondition "startdate", lkOpEqual, Year(dDate), , lkFilterDecoratorYear
- oFilter.AddCondition "statuscaspeco", lkOpNotEqual, 423801
- oFilter.AddOperator lkOpAnd
- oFilter.AddOperator lkOpAnd
- oView.Add "facility"
- oView.Add "startdate"
- oView.Add "enddate"
- Set recsReservations = New LDE.Records
- recsReservations.Open Classes("reservation"), oFilter, oView
- Set rsReservations = New ADODB.Recordset
- rsReservations.Fields.Append "facility", adInteger
- rsReservations.Fields.Append "startdate", adDate
- rsReservations.Fields.Append "enddate", adDate
- rsReservations.Open
- For Each recReservation In recsReservations
- rsReservations.AddNew
- rsReservations("facility") = recReservation("facility")
- rsReservations("startdate") = Format(recReservation("startdate"), "YYYY-MM-DD")
- rsReservations("enddate") = Format(recReservation("enddate"), "YYYY-MM-DD")
- Next
- End If
- If rsReservations.RecordCount > 0 Then
- rsReservations.MoveFirst
- End If
- rsReservations.Find "startdate='" & dDate & "'"
- If Not rsReservations.EOF Then
- isDateReserved = True
- Else
- isDateReserved = False
- End If
- End Function
- Public Sub CreateDocFromTemplate(strTemplate As String, docName As String, docType As String, Optional business As Long, Optional company As Long, Optional person As Long)
- On Error GoTo ErrorHandler
- If (Not ActiveInspector Is Nothing) Then
- ActiveInspector.Save
- Dim oRecord As LDE.Record
- Dim oDocument As New LDE.Document
- Dim oTemplate As LDE.DocumentTemplate
- Dim sFileName As String
- Dim oInspector As Lime.Inspector
- Dim oWorkbook As Object 'Optional variable'
- Dim oExcel As Object
- Set oInspector = Lime.ActiveInspector
- 'Lookup the document template'
- Set oTemplate = Application.Database.Templates.Lookup(strTemplate, lkLookupDocumentTemplateByName)
- If oTemplate Is Nothing Then
- Call Err.Raise(UI.cErrorShowMessageBox, , "Kunde inte hitta mallen '" & strTemplate & "'.")
- End If
- 'Create the document record'
- Set oRecord = New LDE.Record
- Call oRecord.Open(Application.Classes.Item("document"))
- 'Add information to the document record'
- oRecord.Value("comment") = strTemplate
- oRecord.Value("type") = docType
- oRecord.Value("coworker") = ActiveUser.Record.id
- If company <> 0 Then oRecord.Value("company") = company
- If business <> 0 Then oRecord.Value("business") = business
- If person <> 0 Then oRecord.Value("person") = person
- oRecord.Update
- DoEvents
- 'Apply the record on the template (do not show the record or the document)'
- Set oDocument = Application.CreateDocumentFromTemplate(oTemplate, oRecord, , "document", False)
- 'Apply custom information to the document'
- sFileName = LCO.MakeFileName(Application.Database.WorkingFolder, LCO.GenerateGUID() & "." & oDocument.Extension)
- Call oDocument.Save(sFileName)
- '______________________________________________________________________________________________________________________________________________________________'
- 'This part is optional, the ExcelWorkBook.cls class module is not required.'
- 'Set oExcel = CreateObject("Excel.Application")
- 'Set oWorkbook = oExcel.workbooks.Open(sFileName)
- '-------------------------------------------------------------------------------------------------------------------------------------------------------------'
- 'Place your own code here by using functions from the ExcelWorkbook class module '
- '-------------------------------------------------------------------------------------------------------------------------------------------------------------'
- 'Save changes to the document'
- 'Call oWorkbook.SaveWorkbook
- 'Call oWorkbook.CloseWorkbook
- 'End of the optional part'
- '______________________________________________________________________________________________________________________________________________________________'
- Call oDocument.Load(sFileName)
- oRecord.Value("document") = oDocument
- oRecord.Document("document").Name = docName
- Call oRecord.Update
- 'Display the document'
- Call ThisApplication.OpenDocument(oRecord.Document("document"), lkCheckOutDefault)
- Set oTemplate = Nothing
- 'Delete temp-file2015-06-08 aa'
- If (VBA.Right(sFileName, 5) = "}.xls") Then
- VBA.Kill (sFileName)
- End If
- Else
- MsgBox ("You need to open a record")
- End If
- Exit Sub
- ErrorHandler:
- Call UI.ShowError("Reports.CreateDocFromTemplate")
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement