Advertisement
Guest User

Untitled

a guest
Aug 7th, 2018
87
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 34.38 KB | None | 0 0
  1. Option Explicit
  2.  
  3. Const xlCenter = -4108
  4. Const xlEdgeLeft = 7
  5. Const xlContinuous = 1
  6. Const xlLeft = -4131
  7. Const xlRight = -4152
  8. Const xlThick = 4
  9. Const xlEdgeBottom = 9
  10. Const xlEdgeTop = 8
  11.  
  12. Public Sub createInvoiceFromBusiness(docName As String)
  13. Dim oExcel As Object
  14. Dim oDocument As LDE.Document
  15. Dim oRecord As LDE.Record
  16. Dim filename As String
  17.  
  18. On Error GoTo ErrorHandler
  19.  
  20. If ActiveInspector Is Nothing Then Exit Sub
  21.  
  22. If ActiveInspector.Class.Name <> "business" Then
  23. MsgBox "Du måste stå på en affär när du skapar fakturaunderlag!", vbExclamation
  24. Exit Sub
  25. End If
  26.  
  27. StatusBar.Text = "Skapar fakturaunderlag..."
  28. StatusBar.Progress = 10
  29.  
  30. Set oExcel = CreateObject("Excel.Application")
  31.  
  32. oExcel.workbooks.Open WebFolder & "Resources\FaktureringEvent.xltx"
  33.  
  34. StatusBar.Progress = 20
  35.  
  36. With oExcel.worksheets(1).Columns("B")
  37. .Replace "$best", ActiveInspector.Record("person.name")
  38. .Replace "$ftg", ActiveInspector.Record("company.name")
  39. .Replace "$ref", ActiveInspector.Record("person.name")
  40. .Replace "$adress", IIf(ActiveInspector.Record("company.invoiceaddress1") = "", ActiveInspector.Record("company.postaladdress1"), ActiveInspector.Record("company.invoiceaddress1"))
  41. .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")))
  42. .Replace "$datum", Format(Now, "YYYY-MM-DD")
  43. .Replace "$orgnr", ActiveInspector.Record("company.registrationno")
  44. End With
  45.  
  46. oExcel.Visible = False
  47.  
  48. StatusBar.Progress = 30
  49.  
  50. filename = ThisApplication.TemporaryFolder & "\" & docName & ".xlsx"
  51. oExcel.workbooks(1).SaveAs filename
  52.  
  53. oExcel.Quit
  54.  
  55. StatusBar.Progress = 40
  56.  
  57. Set oRecord = New LDE.Record
  58. Call oRecord.Open(Application.Classes.Item("document"))
  59.  
  60. oRecord.Value("comment") = ActiveInspector.Record("name")
  61. oRecord.Value("type") = "Fakturaunderlag"
  62. oRecord.Value("coworker") = ActiveUser.Record.id
  63. oRecord.Value("company") = ActiveInspector.Record("company")
  64. oRecord.Value("business") = ActiveInspector.Record("idbusiness")
  65. oRecord.Value("person") = ActiveInspector.Record("person")
  66.  
  67. StatusBar.Progress = 50
  68.  
  69. Set oDocument = New Document
  70. oDocument.Load filename
  71.  
  72. StatusBar.Progress = 60
  73.  
  74. oRecord.Value("document") = oDocument
  75. oRecord.Document("document").Name = docName
  76.  
  77. oRecord.Update
  78.  
  79. StatusBar.Progress = 80
  80.  
  81. If FileExists(filename) Then
  82. Kill filename
  83. End If
  84.  
  85. StatusBar.Progress = 100
  86.  
  87. Call ThisApplication.OpenDocument(oRecord.Document("document"), lkCheckOutDefault)
  88.  
  89. StatusBar.Progress = 0
  90. StatusBar.Text = ""
  91.  
  92. Exit Sub
  93. ErrorHandler:
  94. Call UI.ShowError("Reports.createInvoiceFromBusiness")
  95. End Sub
  96.  
  97.  
  98. Public Sub showIndividualSalesReport()
  99. Dim startdate As String
  100. Dim enddate As String
  101.  
  102. On Error GoTo ErrorHandler
  103.  
  104. If ActiveExplorer.Class.Name <> "coworker" Then
  105. MsgBox "Du måste stå på medarbetarfliken och välja de medarbetare som skall ingå i rapporten!", vbOKCancel + vbInformation
  106. Exit Sub
  107. End If
  108.  
  109. startdate = InputBox("Startdatum", "Individuell säljrapport", Format(DateSerial(Year(DateAdd("m", -1, Now)), Month(DateAdd("m", -1, Now)), 1), "YYYY-MM-DD"))
  110. If startdate = "" Or Not IsDate(startdate) Then Exit Sub
  111.  
  112. enddate = InputBox("Slutdatum", "Individuell säljrapport", DateSerial(Year(startdate), Month(startdate) + 1, 0))
  113. If enddate = "" Or Not IsDate(enddate) Then Exit Sub
  114.  
  115. createIndividualSalesReport CDate(startdate), CDate(enddate), ActiveExplorer.Selection.Pool
  116.  
  117. Exit Sub
  118. ErrorHandler:
  119. Call UI.ShowError("Reports.showIndividualSalesReport")
  120.  
  121. End Sub
  122.  
  123. Public Sub showSalesReport()
  124. Dim startdate As String
  125. Dim enddate As String
  126.  
  127. On Error GoTo ErrorHandler
  128.  
  129. startdate = InputBox("Startdatum", "Försäljningsrapport GLT", Format(DateSerial(Year(DateAdd("m", -1, Now)), Month(DateAdd("m", -1, Now)), 1), "YYYY-MM-DD"))
  130. If startdate = "" Or Not IsDate(startdate) Then Exit Sub
  131.  
  132. enddate = InputBox("Slutdatum", "Försäljningsrapport GLT", DateSerial(Year(startdate), Month(startdate) + 1, 0))
  133. If enddate = "" Or Not IsDate(enddate) Then Exit Sub
  134.  
  135. createSalesReport CDate(startdate), CDate(enddate)
  136.  
  137. Exit Sub
  138. ErrorHandler:
  139. Call UI.ShowError("Reports.showSalesReport")
  140.  
  141. End Sub
  142.  
  143. Private Sub createSalesReport(startdate As Date, enddate As Date)
  144. Dim oExcel As Object
  145. Dim oWb As Object
  146. Dim oWs As Object
  147. Dim pic As Picture
  148. Dim oProc As LDE.Procedure
  149. Dim oParam As LDE.ProcedureParameter
  150. Dim oFilter As New LDE.Filter
  151. Dim oView As New LDE.View
  152. 'Dim recsEventtype As New LDE.Records
  153. Dim oRec As LDE.Record
  154. Dim y As Integer
  155. Dim i As Integer
  156. Dim rsReportSections As ADODB.Recordset
  157. Dim eventtypeCount As Integer
  158.  
  159. On Error GoTo ErrorHandler
  160.  
  161. StatusBar.Text = "Skapar försäljningsrapport..."
  162. StatusBar.Progress = 10
  163.  
  164. '----- Hämta rapportsektioner
  165. Set rsReportSections = getReportSections
  166. eventtypeCount = rsReportSections.RecordCount
  167. ' oFilter.AddCondition "reportsection", lkOpNotEqual, ""
  168. '
  169. ' oView.Add "reportsection"
  170. ' oView.Add "reportorder", lkSortAscending
  171. '
  172. ' recsEventtype.Open Database.Classes("eventtype"), oFilter, oView
  173. '-------
  174.  
  175. Set oExcel = CreateObject("Excel.Application")
  176. oExcel.Visible = False
  177.  
  178. Set oWb = oExcel.workbooks.Add
  179. Set oWs = oWb.Sheets(1)
  180.  
  181. oWs.Range("1:1").Font.Size = 22
  182. oWs.Range("1:1").Font.Bold = True
  183.  
  184. oWs.Shapes.AddPicture ThisApplication.WebFolder & "\images\prs_logo.gif", True, True, 400, 5, 140, 40
  185.  
  186. StatusBar.Progress = 20
  187.  
  188. '---- Rubriker
  189. oWs.cells(1, 1) = "Försäljningsrapport säljavd " & startdate & " - " & enddate
  190. oWs.cells(3, 2) = "PERIOD UTFALL"
  191. oWs.cells(3, 3) = "PERIOD BUDGET"
  192. oWs.cells(3, 4) = "PERIOD MERFÖRSÄLJNING"
  193. oWs.cells(3, 5) = "BUDGET VS UTFALL"
  194. oWs.cells(3, 6) = "PERIOD UTFALL FG ÅR"
  195. oWs.cells(3, 7) = "UTFALL VS FG ÅR"
  196.  
  197. oWs.cells(3, 8) = "YTD UTFALL"
  198. oWs.cells(3, 9) = "YTD BUDGET"
  199. oWs.cells(3, 10) = "BUDGET VS UTFALL 2"
  200. oWs.cells(3, 11) = "YTD UTFALL FG ÅR"
  201. oWs.cells(3, 12) = "UTFALL VS FG ÅR 2"
  202.  
  203. oWs.cells(3, 13) = "YT BUDGET"
  204. oWs.cells(3, 14) = "YT PROGNOS"
  205. oWs.cells(3, 15) = "YT PROGNOS VS BUDGET"
  206. oWs.cells(3, 16) = "YT PROGNOS FG ÅR"
  207. oWs.cells(3, 17) = "YT PROGNOS FG ÅR VS YT PROGNOS I ÅR"
  208.  
  209. oWs.cells(4, 1) = "ANTAL EVENT GLT"
  210. oWs.cells(5, 1) = "EVENTBESÖKARE GLT"
  211.  
  212. '----- Rubriker för rapportavsnitt
  213. Do While Not rsReportSections.EOF
  214. i = i + 1
  215. oWs.cells(6 + i, 1) = rsReportSections("reportsection")
  216. rsReportSections.MoveNext
  217. Loop
  218.  
  219. oWs.cells(7 + eventtypeCount, 1) = "TOTAL"
  220.  
  221. StatusBar.Progress = 30
  222.  
  223. '---- Formatera celler
  224. oWs.Range("B3:Q3").cells.Horizontalalignment = xlCenter
  225.  
  226. oWs.Columns("A").ColumnWidth = 20
  227. oWs.Columns("B:Q").ColumnWidth = 15
  228. oWs.rows.RowHeight = 20
  229. oWs.rows(1).RowHeight = 30
  230. oWs.rows(3).RowHeight = 30
  231.  
  232. oWs.Range("A3:Q3").Interior.Color = RGB(234, 235, 234)
  233. oWs.Range("A3:Q3").Font.Color = RGB(209, 138, 78)
  234. oWs.Range("A3:Q3").WrapText = True
  235.  
  236. oWs.Range("A3:A" & eventtypeCount + 87).Interior.Color = RGB(234, 235, 234)
  237. oWs.Range("A3:A" & eventtypeCount + 8).Font.Color = RGB(209, 138, 78)
  238. oWs.Range("A" & eventtypeCount + 8 & ":Q" & eventtypeCount + 8).Interior.Color = RGB(234, 235, 234)
  239. ' oWs.Range("A" & eventtypecount + 7 & ":Q" & eventtypecount + 7).Font.Color = RGB(209, 138, 78)
  240.  
  241. oWs.Range("A6:Q6").Interior.Color = RGB(117, 150, 169)
  242.  
  243. StatusBar.Progress = 50
  244.  
  245. '---- Värden för rapportavsnitt
  246. writeSalesSectionToExcel startdate, enddate, 2, oWs, rsReportSections 'period utfall
  247. writeSalesSectionToExcel DateAdd("yyyy", -1, startdate), DateAdd("yyyy", -1, enddate), 6, oWs, rsReportSections 'period utfall fg år
  248.  
  249. StatusBar.Progress = 80
  250.  
  251. writeSalesSectionToExcel DateSerial(Year(startdate), 1, 1), enddate, 8, oWs, rsReportSections 'Ytd utfall
  252. writeSalesSectionToExcel DateAdd("yyyy", -1, startdate), DateAdd("yyyy", -1, DateSerial(Year(enddate), Month(enddate), Day(enddate))), 11, oWs, rsReportSections
  253.  
  254.  
  255. '---- Formler för fältsummering på rad
  256. For i = 2 To 17
  257. oWs.Range(Chr(64 + i) & eventtypeCount + 7).formula = "=SUM(" & Chr(64 + i) & "7:" & Chr(64 + i) & 6 + eventtypeCount & ")"
  258. Next i
  259.  
  260. '---- Formler för kolumsummering av rapportavsnitt
  261. For i = 4 To eventtypeCount + 6
  262. If i <> 6 Then
  263. oWs.Range("E" & i).formula = "=B" & i & "-C" & i
  264. oWs.Range("G" & i).formula = "=B" & i & "-F" & i
  265. oWs.Range("J" & i).formula = "=H" & i & "-I" & i
  266. oWs.Range("L" & i).formula = "=H" & i & "-K" & i
  267. oWs.Range("O" & i).formula = "=M" & i & "-N" & i
  268. oWs.Range("Q" & i).formula = "=N" & i & "-P" & i
  269. End If
  270. Next i
  271. '--------
  272.  
  273. StatusBar.Progress = 100
  274.  
  275. oExcel.Visible = True
  276.  
  277. StatusBar.Progress = 0
  278. StatusBar.Text = ""
  279.  
  280. Exit Sub
  281. ErrorHandler:
  282. StatusBar.Progress = 0
  283. StatusBar.Text = ""
  284. Call UI.ShowError("Reports.createIndividualSalesReport")
  285.  
  286. End Sub
  287.  
  288. Private Sub writeSalesSectionToExcel(startdate As Date, enddate As Date, col As Integer, oWs As Object, rsReportSections As ADODB.Recordset)
  289. Dim oProc As LDE.Procedure
  290. Dim oParam As LDE.ProcedureParameter
  291. Dim y As Integer
  292. Dim i As Integer
  293.  
  294. On Error GoTo ErrorHandler
  295.  
  296. If rsReportSections.RecordCount > 0 Then rsReportSections.MoveFirst
  297.  
  298. y = 4
  299.  
  300. Set oProc = Database.Procedures("csp_getSalesReportdata")
  301. oProc.Parameters("@startdate").InputValue = startdate
  302. oProc.Parameters("@enddate").InputValue = enddate
  303. oProc.Parameters("@rapportsektion").InputValue = ""
  304. oProc.Execute False
  305.  
  306. oWs.cells(y, col) = oProc.Parameters("@antalevent").OutputValue
  307. oWs.cells(y + 1, col) = oProc.Parameters("@eventbesokare").OutputValue
  308.  
  309. oWs.cells(y, col + 1) = oProc.Parameters("@budgeteventcount").OutputValue
  310. oWs.cells(y + 1, col + 1) = oProc.Parameters("@budgetvisitors").OutputValue
  311.  
  312.  
  313. Do While Not rsReportSections.EOF
  314. i = i + 1
  315. oProc.Parameters("@startdate").InputValue = startdate
  316. oProc.Parameters("@enddate").InputValue = enddate
  317.  
  318. oProc.Parameters("@rapportsektion").InputValue = CStr(rsReportSections("reportsection"))
  319. oProc.Execute False
  320. oWs.cells(y + 2 + i, col) = oProc.Parameters("@intakt").OutputValue
  321. oWs.cells(y + 2 + i, col + 1) = oProc.Parameters("@budget").OutputValue
  322. If col < 4 Then
  323. oWs.cells(y + 2 + i, col + 2) = oProc.Parameters("@merfors").OutputValue
  324. End If
  325.  
  326. rsReportSections.MoveNext
  327. Loop
  328.  
  329. Exit Sub
  330. ErrorHandler:
  331. Call UI.ShowError("Reports.writeSectionToExcel")
  332.  
  333. End Sub
  334.  
  335.  
  336. Public Sub createIndividualSalesReport(startdate As Date, enddate As Date, Optional pCoworkers As LDE.Pool)
  337. Dim oExcel As Object
  338. Dim oWb As Object
  339. Dim oWs As Object
  340. Dim pic As Picture
  341. Dim oProc As LDE.Procedure
  342. Dim oParam As LDE.ProcedureParameter
  343. Dim i As Integer
  344. Dim n As Integer
  345. Dim y As Integer
  346. 'Dim oFilter As New LDE.Filter
  347. 'Dim oView As New LDE.View
  348. 'Dim recsEventtype As New LDE.Records
  349. Dim oRec As LDE.Record
  350. Dim endCol As String
  351. Dim rsReportSections As ADODB.Recordset
  352. Dim moresale As Long
  353. Dim moresaleotherparks As Long
  354.  
  355. On Error GoTo ErrorHandler
  356.  
  357. StatusBar.Text = "Skapar indiviuell försäljningsrapport..."
  358. StatusBar.Progress = 1
  359.  
  360. '----- Hämta rapportsektioner
  361. Set rsReportSections = getReportSections
  362.  
  363. '------- Skapa excel-blad
  364. Set oExcel = CreateObject("Excel.Application")
  365.  
  366. Set oWb = oExcel.workbooks.Add
  367. Set oWs = oWb.Sheets(1)
  368.  
  369. oWs.Range("1:1").Font.Size = 22
  370. oWs.Range("1:1").Font.Bold = True
  371.  
  372. oWs.Shapes.AddPicture ThisApplication.WebFolder & "\images\prs_logo.gif", True, True, 239, 5, 140, 40
  373.  
  374.  
  375. '------- Kolumnrubriker
  376. oWs.cells(1, 1) = "SÄLJRAPPORT " & startdate & " - " & enddate
  377. oWs.cells(3, 1) = "Säljare"
  378. oWs.cells(3, 2) = "BESÖKTA KUNDER"
  379. oWs.cells(3, 3) = "SKICKADE OFFERTER"
  380. oWs.cells(3, 4) = "BOKADE AFFÄRER"
  381.  
  382. '----- Rubriker för rapportavsnitt
  383. Do While Not rsReportSections.EOF
  384. i = i + 1
  385. oWs.cells(3, i + 4) = rsReportSections("reportsection")
  386. rsReportSections.MoveNext
  387. Loop
  388.  
  389. oWs.cells(3, i + 5) = "MERFÖRSÄLJNING"
  390. oWs.cells(3, i + 6) = "INTÄKTER PRS"
  391.  
  392. endCol = Chr(70 + i)
  393.  
  394. '------- Formatera rubriker
  395. oWs.Range("B3:" & endCol & "3").cells.Horizontalalignment = xlCenter
  396. oWs.Columns("A:" & endCol).ColumnWidth = 20
  397. oWs.rows.RowHeight = 20
  398. oWs.rows(1).RowHeight = 30
  399.  
  400. oWs.Range("A3:" & endCol & "3").Interior.Color = RGB(234, 235, 234)
  401. oWs.Range("A3:" & endCol & "3").Font.Color = RGB(209, 138, 78)
  402.  
  403.  
  404. y = 4
  405.  
  406. For i = 0 To pCoworkers.Count - 1
  407.  
  408. StatusBar.Progress = Int((i / pCoworkers.Count) * 100)
  409.  
  410. '------- Hämta allmänna rapportsiffror ej knutna till rapportsektioner
  411. Set oProc = Database.Procedures("csp_getIndividualSalesReportdata")
  412. oProc.Parameters("@idcoworker").InputValue = pCoworkers(i)
  413. oProc.Parameters("@startdate").InputValue = startdate
  414. oProc.Parameters("@enddate").InputValue = enddate
  415. oProc.Parameters("@rapportsektion").InputValue = ""
  416.  
  417. oProc.Execute False
  418.  
  419. With oWs
  420. .cells(y, 1) = oProc.Parameters("@name").OutputValue
  421. .cells(y + 1, 1) = "Summa"
  422. .cells(y + 2, 1) = "MÅL"
  423. .cells(y + 3, 1) = "AVVIKELSE"
  424.  
  425. .Range("A" & y & ":A" & y).Font.Bold = True
  426. .Range("A" & y & ":A" & y).Font.Underline = True
  427. .Range("A" & y & ":" & endCol & y).Interior.Color = RGB(234, 235, 234)
  428.  
  429. .Range("A" & y + 2 & ":" & endCol & y + 3).Interior.Color = RGB(237, 208, 184)
  430. .Range("A" & y + 2 & ":A" & y + 3).Font.Color = RGB(209, 138, 78)
  431. .Range("A" & y + 2 & ":A" & y + 3).Font.Bold = True
  432.  
  433. .Range("A" & y + 1 & ":" & endCol & y + 1).Interior.Color = RGB(131, 186, 150)
  434.  
  435. .Range("B" & y + 1 & ":" & endCol & y + 3).cells.Borders(xlEdgeLeft).LineStyle = xlContinuous
  436.  
  437. .Range("B" & y + 1 & ":" & endCol & y + 3).cells.Horizontalalignment = xlCenter
  438.  
  439. .cells(y + 1, 2) = oProc.Parameters("@customervisits").OutputValue
  440. .cells(y + 1, 3) = oProc.Parameters("@quotes").OutputValue
  441. .cells(y + 1, 4) = oProc.Parameters("@bookings").OutputValue
  442. .cells(y + 2, 2) = oProc.Parameters("@t_customervisits").OutputValue
  443. moresale = oProc.Parameters("@moresale").OutputValue
  444. moresaleotherparks = oProc.Parameters("@moresaleotherparks").OutputValue
  445. '------- Hämta rapportsektionssiffror
  446. n = 0
  447. If rsReportSections.RecordCount > 0 Then rsReportSections.MoveFirst
  448.  
  449. Do While Not rsReportSections.EOF
  450. n = n + 1
  451. oProc.Parameters("@idcoworker").InputValue = pCoworkers(i)
  452. oProc.Parameters("@startdate").InputValue = startdate
  453. oProc.Parameters("@enddate").InputValue = enddate
  454.  
  455. oProc.Parameters("@rapportsektion").InputValue = CStr(rsReportSections("reportsection"))
  456. oProc.Execute False
  457.  
  458. oWs.cells(y + 1, 4 + n) = oProc.Parameters("@intakt").OutputValue
  459. oWs.Range(Chr(68 + n) & y + 3).formula = "=-(" & Chr(68 + n) & y + 2 & " - " & Chr(68 + n) & y + 1 & ")"
  460. rsReportSections.MoveNext
  461. Loop
  462.  
  463. oWs.cells(y + 1, 5 + n) = moresale
  464. oWs.Range(Chr(69 + n) & y + 3).formula = "=-(" & Chr(69 + n) & y + 2 & " - " & Chr(69 + n) & y + 1 & ")"
  465.  
  466. oWs.cells(y + 1, 6 + n) = moresaleotherparks
  467. oWs.Range(Chr(70 + n) & y + 3).formula = "=-(" & Chr(70 + n) & y + 2 & " - " & Chr(70 + n) & y + 1 & ")"
  468.  
  469. '------ Summeringsformel för respektive kolumn
  470. .Range("B" & y + 3).formula = "=-(B" & y + 2 & " - B" & y + 1 & ")"
  471. End With
  472.  
  473. y = y + 4
  474. Next i
  475.  
  476. StatusBar.Text = ""
  477. StatusBar.Progress = 0
  478.  
  479. oExcel.Visible = True
  480.  
  481. Exit Sub
  482. ErrorHandler:
  483. Call UI.ShowError("Reports.createIndividualSalesReport")
  484.  
  485. End Sub
  486.  
  487. Public Function getReportSections() As ADODB.Recordset
  488. Dim oFilter As New LDE.Filter
  489. Dim oView As New LDE.View
  490. Dim recsEventtype As New LDE.Records
  491. Dim i As Integer
  492.  
  493. On Error GoTo ErrorHandler
  494.  
  495. oFilter.AddCondition "reportsection", lkOpNotEqual, ""
  496.  
  497. oView.Add "reportsection"
  498. oView.Add "reportorder", lkSortAscending
  499.  
  500. recsEventtype.Open Database.Classes("eventtype"), oFilter, oView
  501.  
  502. Set getReportSections = New ADODB.Recordset
  503. getReportSections.Fields.Append "reportsection", adVarChar, 100
  504. getReportSections.Open
  505.  
  506. For i = 1 To recsEventtype.Count
  507. If getReportSections.RecordCount > 0 Then getReportSections.MoveFirst
  508.  
  509. getReportSections.Find "reportsection='" & recsEventtype(i)("reportsection") & "'"
  510.  
  511. If getReportSections.EOF Then
  512. getReportSections.AddNew "reportsection", recsEventtype(i)("reportsection")
  513. End If
  514. Next i
  515.  
  516. If getReportSections.RecordCount > 0 Then getReportSections.MoveFirst
  517.  
  518. Exit Function
  519. ErrorHandler:
  520. Call UI.ShowError("Reports.getReportSections")
  521. End Function
  522.  
  523. Public Sub createBusinessList()
  524. Dim oExcel As Object
  525. Dim oWb As Object
  526. Dim oWs As Object
  527. Dim finished As Boolean
  528. Dim strYear As String
  529. Dim dDate As Date
  530. Dim i As Integer
  531. Dim oFilter As New LDE.Filter
  532. Dim oView As New LDE.View
  533. Dim recs As New LDE.Records
  534. Dim rec As LDE.Record
  535. Dim reccount As Integer
  536. Dim n As Integer
  537. Dim bookedid As Long
  538. Dim lastdate As Date
  539. Dim oProc As LDE.Procedure
  540. Dim oParam As LDE.ProcedureParameter
  541.  
  542. On Error GoTo ErrorHandler
  543.  
  544. strYear = InputBox("År", "Affärsöversikt", Year(Now))
  545.  
  546. If Not IsNumeric(strYear) Then Exit Sub
  547.  
  548. StatusBar.Text = "Skapar affärsöversikt..."
  549. StatusBar.Progress = 1
  550.  
  551. oFilter.AddCondition "park", lkOpEqual, Classes("business").Fields("park").Options.Lookup("glt", lkLookupOptionByKey)
  552. oFilter.AddCondition "arrivaldate", lkOpGreaterOrEqual, DateSerial(strYear, 1, 1)
  553. oFilter.AddOperator lkOpAnd
  554. oFilter.AddCondition "arrivaldate", lkOpLessOrEqual, DateSerial(strYear, 12, 31)
  555. oFilter.AddOperator lkOpAnd
  556. oFilter.AddCondition "currentstatus", lkOpEqual, Classes("business").Fields("currentstatus").Options.Lookup("booked", lkLookupOptionByKey)
  557. oFilter.AddCondition "currentstatus", lkOpEqual, Classes("business").Fields("currentstatus").Options.Lookup("quote", lkLookupOptionByKey)
  558. oFilter.AddCondition "currentstatus", lkOpEqual, Classes("business").Fields("currentstatus").Options.Lookup("preliminary", lkLookupOptionByKey)
  559. oFilter.AddOperator lkOpOr
  560. oFilter.AddOperator lkOpOr
  561. oFilter.AddOperator lkOpAnd
  562.  
  563. oFilter.Name = "Affärslista"
  564.  
  565.  
  566. oView.Add "arrivaldate", lkSortAscending
  567. oView.Add "eventtime", lkSortAscending
  568. oView.Add "eventtype"
  569. oView.Add "name" 'eventnamn
  570. oView.Add "company" 'företag
  571. oView.Add "person" 'kontaktperson
  572. oView.Add "salesperson"
  573. oView.Add "coworker3"
  574. oView.Add "numberofparticipants"
  575. oView.Add "participantsactual"
  576. oView.Add "total"
  577. oView.Add "comment"
  578. oView.Add "currentstatus"
  579.  
  580. recs.Open Database.Classes("business"), oFilter, oView
  581.  
  582. bookedid = Classes("business").Fields("currentstatus").Options.Lookup("booked", lkLookupOptionByKey)
  583.  
  584. '------- Skapa excel-blad
  585. Set oExcel = CreateObject("Excel.Application")
  586.  
  587. Set oWb = oExcel.workbooks.Add
  588. Set oWs = oWb.Sheets(1)
  589.  
  590. oWs.cells(1, 1) = "Datum"
  591. oWs.cells(1, 2) = "Dag"
  592. oWs.cells(1, 3) = "Tid"
  593. oWs.cells(1, 4) = "Lokal"
  594. oWs.cells(1, 5) = "Aktivitetstyp"
  595. oWs.cells(1, 6) = "Affärsnamn"
  596. oWs.cells(1, 7) = "Företag"
  597. oWs.cells(1, 8) = "Kontakt"
  598. oWs.cells(1, 9) = "Säljare"
  599. oWs.cells(1, 10) = "Projektledare"
  600. oWs.cells(1, 11) = "Kommentar"
  601. oWs.cells(1, 12) = "Mini antal"
  602. oWs.cells(1, 13) = "Verkligt antal"
  603. oWs.cells(1, 14) = "Fakturerat"
  604.  
  605. oWs.ListObjects.Add(1, oWs.Range("$A$1:$N$366"), , 1).Name = "Tabell1"
  606. oWs.ListObjects("Tabell1").TableStyle = "TableStyleMedium2"
  607.  
  608. oWs.Range("$A$1:$N$366").Borders.LineStyle = 1
  609. oWs.Range("$A$1:$A$366").NumberFormat = "[$-sv-SE]dd/mmm;@"
  610.  
  611. oWs.Columns.ColumnWidth = 20
  612. oWs.Columns("A").ColumnWidth = 10
  613. oWs.Columns("B").ColumnWidth = 10
  614. oWs.Columns("B").Horizontalalignment = xlRight
  615. oWs.cells(1, 2).Horizontalalignment = xlLeft
  616.  
  617. oWs.Range("A:A").Interior.Color = RGB(47, 117, 181)
  618. oWs.Range("A1:N1").Interior.Color = RGB(47, 117, 181)
  619. oWs.Range("A:A").Font.Color = RGB(255, 255, 255)
  620. oWs.Range("A1:N1").Font.Color = RGB(255, 255, 255)
  621. oWs.Range("A1:N1").Font.Bold = True
  622.  
  623. dDate = DateSerial(strYear, 1, 1)
  624. i = 2
  625.  
  626. Do While Not finished
  627. oWs.cells(i, 1) = dDate
  628. oWs.cells(i, 2).formula = "=TEXT(A" & i & ",""ddd"")"
  629. If Weekday(dDate) = vbMonday And i > 4 Then
  630. oWs.rows(i).Borders(xlEdgeTop).Weight = xlThick
  631. End If
  632. i = i + 1
  633.  
  634. dDate = DateAdd("d", 1, dDate)
  635.  
  636. If Year(dDate) <> strYear Then finished = True
  637. Loop
  638.  
  639. 'oWs.Range("$B$1:$B$366").NumberFormat = "hh:mm;@"
  640.  
  641. i = 1
  642.  
  643. reccount = recs.Count
  644. Set oProc = Database.Procedures("csp_getPlacesForBusiness")
  645.  
  646.  
  647. For Each rec In recs
  648. n = n + 1
  649. StatusBar.Progress = Int((n / reccount) * 100)
  650.  
  651. 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
  652. oWs.cells(i, 1).offset(1).entirerow.Insert Shift:=-4121
  653. i = i + 1
  654. oWs.cells(i, 2).formula = ""
  655. If i > 366 Then
  656. oWs.cells(i, 2).formula = "=TEXT(A" & i & "," & Chr(34) & Chr(34) & ")"
  657. End If
  658. Else
  659. While oWs.cells(i, 1) <> rec("arrivaldate") And i < 1000
  660. i = i + 1
  661. Wend
  662. End If
  663.  
  664. lastdate = rec("arrivaldate")
  665.  
  666. oWs.cells(i, 3) = rec("eventtime")
  667.  
  668. oProc.Parameters("@idbusiness") = rec.id
  669. oProc.Execute False
  670. oWs.cells(i, 4) = oProc.Parameters("@return").OutputValue
  671.  
  672. If Not IsNull(rec("eventtype")) Then oWs.cells(i, 5) = rec("eventtype.eventname")
  673. If Not IsNull(rec("name")) Then oWs.cells(i, 6) = rec("name")
  674. If Not IsNull(rec("company")) Then oWs.cells(i, 7) = rec("company.name")
  675. If Not IsNull(rec("person")) Then oWs.cells(i, 8) = rec("person.name")
  676. If Not IsNull(rec("salesperson")) Then oWs.cells(i, 9) = rec("salesperson.name")
  677. If Not IsNull(rec("coworker3")) Then oWs.cells(i, 10) = rec("coworker3.name")
  678. oWs.cells(i, 11) = rec("comment")
  679. oWs.cells(i, 12) = rec("numberofparticipants")
  680. oWs.cells(i, 13) = rec("participantsactual")
  681. oWs.cells(i, 14) = rec("total")
  682.  
  683. If rec("currentstatus") <> bookedid Then
  684. oWs.rows(i).Font.Italic = True
  685. oWs.cells(i, 1).Font.Italic = False
  686. oWs.cells(i, 2).Font.Italic = False
  687. oWs.cells(i, 11) = "OFFERT/PREL " & rec("comment")
  688. End If
  689. Next
  690.  
  691. oExcel.Visible = True
  692.  
  693. StatusBar.Text = ""
  694. StatusBar.Progress = 0
  695.  
  696. Exit Sub
  697. ErrorHandler:
  698. Call UI.ShowError("Reports.createBusinessList")
  699.  
  700. End Sub
  701.  
  702. Public Sub dumpFilter(oFilter As LDE.Filter)
  703. Dim i As Integer
  704. Dim str As String
  705. Dim op As OperatorEnum
  706. On Error Resume Next
  707.  
  708. For i = 1 To 11
  709.  
  710. str = oFilter.Item(i).field
  711. str = str & " " & oFilter.Item(i).Operator
  712. str = str & oFilter.Item(i).Value
  713.  
  714. Select Case oFilter.Item(i).Operator
  715. Case 9
  716. str = str & " AND"
  717. Case 1
  718. str = str & " OR"
  719. End Select
  720. Debug.Print str
  721. Next i
  722.  
  723. End Sub
  724.  
  725. Public Sub showOverviewCalendar()
  726. Dim sYear As String
  727.  
  728. sYear = InputBox("År", "Visa översiktskalender för events", Year(Now))
  729. If IsNumeric(sYear) Then
  730. isDateReserved 1007, DateSerial(CInt(sYear), 1, 1), True
  731. createOverviewCalendar 1007, sYear
  732. End If
  733.  
  734. End Sub
  735.  
  736.  
  737.  
  738. Public Function createOverviewCalendar(facility As Long, sYear As String) As Object
  739. Dim lMonth As Long
  740. Dim strMonth As String
  741. Dim rStart As Object
  742. Dim strAddress As String
  743. Dim rCell As Object
  744. Dim lDays As Long
  745. Dim dDate As Date
  746. Dim oExcel As Object
  747. Dim oWb As Object
  748. Dim oWs As Object
  749.  
  750. Set oExcel = CreateObject("Excel.Application")
  751.  
  752. Set oWb = oExcel.workbooks.Add
  753. Set oWs = oWb.Sheets(1)
  754.  
  755. 'Add new sheet and format
  756.  
  757. 'ActiveWindow.DisplayGridlines = False
  758. With oWs.cells
  759. .ColumnWidth = 10#
  760. .Font.Size = 14
  761. End With
  762.  
  763. 'Create the Month headings
  764. For lMonth = 1 To 4
  765. Select Case lMonth
  766. Case 1
  767. strMonth = "Januari"
  768. Set rStart = oWs.Range("A1")
  769. Case 2
  770. strMonth = "April"
  771. Set rStart = oWs.Range("A8")
  772. Case 3
  773. strMonth = "Juli"
  774. Set rStart = oWs.Range("A15")
  775. Case 4
  776. strMonth = "Oktober"
  777. Set rStart = oWs.Range("A22")
  778. End Select
  779.  
  780. 'Merge, AutoFill and align months
  781. With rStart
  782.  
  783. .Value = strMonth
  784. .Horizontalalignment = xlCenter
  785. .Interior.colorindex = 6
  786. .Font.Bold = True
  787. With .Range("A1:G1")
  788. .Merge
  789. .BorderAround LineStyle:=xlContinuous
  790. End With
  791. .Range("A1:G1").AutoFill Destination:=.Range("A1:U1")
  792. End With
  793. Next lMonth
  794.  
  795.  
  796. 'Pass ranges for months
  797. For lMonth = 1 To 12
  798. strAddress = Choose(lMonth, "A2:G7", "H2:N7", "O2:U7", _
  799. "A9:G14", "H9:N14", "O9:U14", _
  800. "A16:G21", "H16:N21", "O16:U21", _
  801. "A23:G28", "H23:N28", "O23:U28")
  802. lDays = 0
  803. oWs.Range(strAddress).BorderAround LineStyle:=1
  804. 'Add dates to month range and format
  805. For Each rCell In oWs.Range(strAddress)
  806. lDays = lDays + 1
  807. dDate = DateSerial(Year(Date), lMonth, lDays)
  808. If Month(dDate) = lMonth Then ' It's a valid date
  809. With rCell
  810. .Value = dDate
  811. .NumberFormat = "ddd dd"
  812.  
  813. If isDateReserved(facility, DateSerial(CInt(sYear), Month(dDate), Day(dDate))) Then
  814. .Interior.colorindex = 36
  815. End If
  816. End With
  817. End If
  818. Next rCell
  819. Next lMonth
  820.  
  821.  
  822. 'add con formatting
  823. With oWs.Range("A1:U28")
  824. .FormatConditions.Add Type:=1, Operator:=3, Formula1:="=TODAY()"
  825. .FormatConditions(1).Font.colorindex = 2
  826. .FormatConditions(1).Interior.colorindex = 1
  827. End With
  828.  
  829. oWs.Range("A1").entirerow.Insert
  830. oWs.Range("A1").entirerow.Insert
  831. oWs.cells(1, 1) = "Översikt"
  832. oWs.cells(1, 2) = sYear
  833. oWs.cells(1, 5) = "Event"
  834. oWs.cells(1, 5).Interior.colorindex = 36
  835.  
  836. oExcel.Visible = True
  837.  
  838. 'Set CreateCalendar = oExcel
  839.  
  840. End Function
  841.  
  842. Public Function isDateReserved(facility As Long, dDate As Date, Optional init As Boolean) As Boolean
  843. Static rsReservations As ADODB.Recordset
  844. Dim recsReservations As LDE.Records
  845. Dim recReservation As LDE.Record
  846. Dim oFilter As New LDE.Filter
  847. Dim oView As New LDE.View
  848.  
  849. If init Then
  850. Set rsReservations = Nothing
  851. End If
  852.  
  853. If rsReservations Is Nothing Then
  854. oFilter.AddCondition "facility", lkOpEqual, facility
  855. oFilter.AddCondition "startdate", lkOpEqual, Year(dDate), , lkFilterDecoratorYear
  856. oFilter.AddCondition "statuscaspeco", lkOpNotEqual, 423801
  857. oFilter.AddOperator lkOpAnd
  858. oFilter.AddOperator lkOpAnd
  859.  
  860. oView.Add "facility"
  861. oView.Add "startdate"
  862. oView.Add "enddate"
  863.  
  864. Set recsReservations = New LDE.Records
  865. recsReservations.Open Classes("reservation"), oFilter, oView
  866.  
  867. Set rsReservations = New ADODB.Recordset
  868. rsReservations.Fields.Append "facility", adInteger
  869. rsReservations.Fields.Append "startdate", adDate
  870. rsReservations.Fields.Append "enddate", adDate
  871. rsReservations.Open
  872.  
  873. For Each recReservation In recsReservations
  874. rsReservations.AddNew
  875. rsReservations("facility") = recReservation("facility")
  876. rsReservations("startdate") = Format(recReservation("startdate"), "YYYY-MM-DD")
  877. rsReservations("enddate") = Format(recReservation("enddate"), "YYYY-MM-DD")
  878. Next
  879. End If
  880.  
  881. If rsReservations.RecordCount > 0 Then
  882. rsReservations.MoveFirst
  883. End If
  884.  
  885. rsReservations.Find "startdate='" & dDate & "'"
  886.  
  887. If Not rsReservations.EOF Then
  888. isDateReserved = True
  889. Else
  890. isDateReserved = False
  891. End If
  892.  
  893. End Function
  894.  
  895. Public Sub CreateDocFromTemplate(strTemplate As String, docName As String, docType As String, Optional business As Long, Optional company As Long, Optional person As Long)
  896. On Error GoTo ErrorHandler
  897.  
  898. If (Not ActiveInspector Is Nothing) Then
  899.  
  900. ActiveInspector.Save
  901.  
  902. Dim oRecord As LDE.Record
  903. Dim oDocument As New LDE.Document
  904. Dim oTemplate As LDE.DocumentTemplate
  905. Dim sFileName As String
  906. Dim oInspector As Lime.Inspector
  907. Dim oWorkbook As Object 'Optional variable'
  908. Dim oExcel As Object
  909.  
  910. Set oInspector = Lime.ActiveInspector
  911.  
  912.  
  913. 'Lookup the document template'
  914. Set oTemplate = Application.Database.Templates.Lookup(strTemplate, lkLookupDocumentTemplateByName)
  915.  
  916. If oTemplate Is Nothing Then
  917. Call Err.Raise(UI.cErrorShowMessageBox, , "Kunde inte hitta mallen '" & strTemplate & "'.")
  918. End If
  919.  
  920. 'Create the document record'
  921. Set oRecord = New LDE.Record
  922. Call oRecord.Open(Application.Classes.Item("document"))
  923.  
  924. 'Add information to the document record'
  925. oRecord.Value("comment") = strTemplate
  926. oRecord.Value("type") = docType
  927. oRecord.Value("coworker") = ActiveUser.Record.id
  928. If company <> 0 Then oRecord.Value("company") = company
  929. If business <> 0 Then oRecord.Value("business") = business
  930. If person <> 0 Then oRecord.Value("person") = person
  931.  
  932. oRecord.Update
  933. DoEvents
  934.  
  935. 'Apply the record on the template (do not show the record or the document)'
  936. Set oDocument = Application.CreateDocumentFromTemplate(oTemplate, oRecord, , "document", False)
  937.  
  938. 'Apply custom information to the document'
  939. sFileName = LCO.MakeFileName(Application.Database.WorkingFolder, LCO.GenerateGUID() & "." & oDocument.Extension)
  940.  
  941. Call oDocument.Save(sFileName)
  942.  
  943. '______________________________________________________________________________________________________________________________________________________________'
  944. 'This part is optional, the ExcelWorkBook.cls class module is not required.'
  945.  
  946. 'Set oExcel = CreateObject("Excel.Application")
  947. 'Set oWorkbook = oExcel.workbooks.Open(sFileName)
  948.  
  949. '-------------------------------------------------------------------------------------------------------------------------------------------------------------'
  950. 'Place your own code here by using functions from the ExcelWorkbook class module '
  951. '-------------------------------------------------------------------------------------------------------------------------------------------------------------'
  952.  
  953. 'Save changes to the document'
  954. 'Call oWorkbook.SaveWorkbook
  955. 'Call oWorkbook.CloseWorkbook
  956.  
  957. 'End of the optional part'
  958. '______________________________________________________________________________________________________________________________________________________________'
  959.  
  960.  
  961. Call oDocument.Load(sFileName)
  962. oRecord.Value("document") = oDocument
  963. oRecord.Document("document").Name = docName
  964. Call oRecord.Update
  965.  
  966. 'Display the document'
  967. Call ThisApplication.OpenDocument(oRecord.Document("document"), lkCheckOutDefault)
  968. Set oTemplate = Nothing
  969.  
  970. 'Delete temp-file2015-06-08 aa'
  971. If (VBA.Right(sFileName, 5) = "}.xls") Then
  972. VBA.Kill (sFileName)
  973. End If
  974.  
  975. Else
  976. MsgBox ("You need to open a record")
  977. End If
  978.  
  979. Exit Sub
  980. ErrorHandler:
  981. Call UI.ShowError("Reports.CreateDocFromTemplate")
  982. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement