API tools faq
paste
Guest User

Untitled

a guest
Jun 24th, 2024
92
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 8.60 KB | None | 0 0
raw download clone embed print report
  1. Sub Road()
  2. Dim Worker_ID As Variant
  3. Dim Worker_name As Variant
  4. Dim Car_ID As Variant
  5. Dim Worker_mail As Variant
  6. Dim Full_payment As Variant
  7. Dim Company_payment As Variant
  8. Dim Worker_payment As Variant
  9. Dim Name As Variant
  10. Dim PdfFile As String
  11. Dim FolderPath As String
  12. Dim i As Integer, j As Integer
  13. Dim CurrentDate As String
  14. Dim FSO As Object
  15. Dim totalFee As Double
  16. Dim vat As Double
  17. Dim RowCounter As Integer
  18. Dim startRow As Integer
  19. Dim CategoryRow As Integer
  20.  
  21. ' Create folder based on current date and time
  22. Set FSO = CreateObject("Scripting.FileSystemObject")
  23. CurrentDate = Format(Now, "yyyy-mm-dd_hh-nn-ss")
  24. FolderPath = "C:\Users\Ori\Documents\work\road 6\" & CurrentDate & "\"
  25.  
  26. ' Check if the folder exists, if not, create it
  27. If Not FSO.FolderExists(FolderPath) Then
  28. FSO.CreateFolder (FolderPath)
  29. End If
  30.  
  31. ' Define the template row (assuming Row 61 in "Show" sheet contains the desired formatting)
  32. Dim TemplateRow As Range
  33. Set TemplateRow = Sheets("Show").Range("A61:I61")
  34.  
  35. For i = 2 To Sheets("DATA").Range("A65000").End(xlUp).Row
  36. ' Initialize totals
  37. totalFee = 0
  38.  
  39. ' Insert the worker id
  40. Worker_ID = Sheets("DATA").Range("A" & i).Value
  41. Sheets("Show").Range("B8").Value = Worker_ID
  42. ' Insert the worker name
  43. Worker_name = Sheets("DATA").Range("E" & i).Value
  44. Sheets("Show").Range("B7").Value = Worker_name
  45. ' Insert the worker car ID
  46. Car_ID = Sheets("DATA").Range("B" & i).Value
  47. Sheets("Show").Range("B9").Value = Car_ID
  48. ' Insert the worker email
  49. Worker_mail = Sheets("DATA").Range("F" & i).Value
  50. Sheets("Show").Range("C10").Value = Worker_mail
  51. ' Insert how much the payment is
  52. Full_payment = Sheets("DATA").Range("H" & i).Value
  53. Sheets("Show").Range("E19").Value = Full_payment
  54. ' Insert how much of the payment the company will cover
  55. Company_payment = Sheets("DATA").Range("I" & i).Value
  56. Sheets("Show").Range("E20").Value = Company_payment
  57. ' Insert how much of the payment the worker is paying
  58. Worker_payment = Sheets("DATA").Range("J" & i).Value
  59. Sheets("Show").Range("E21").Value = Worker_payment
  60. Name = Sheets("DATA").Range("E" & i).Value
  61.  
  62. ' Initialize RowCounter and StartRow
  63. RowCounter = 63
  64. startRow = 7
  65.  
  66. ' Loop through Driving Data for the current car ID
  67. Do While Sheets("Driving Data").Range("B" & startRow).Value = Car_ID
  68. ' Debugging: Check if the correct Car_ID is being matched
  69. Debug.Print "Car_ID: " & Car_ID & " | Driving Data Car_ID: " & Sheets("Driving Data").Range("B" & startRow).Value
  70.  
  71. ' Copy the template row formatting
  72. TemplateRow.Copy
  73. Sheets("Show").Range("A" & RowCounter & ":I" & RowCounter).PasteSpecial Paste:=xlPasteFormats
  74.  
  75. ' Insert data into Show sheet
  76. Sheets("Show").Range("A" & RowCounter).Value = Sheets("Driving Data").Range("A" & startRow).Value
  77. Sheets("Show").Range("B" & RowCounter).Value = Sheets("Driving Data").Range("B" & startRow).Value
  78. Sheets("Show").Range("C" & RowCounter).Value = Sheets("Driving Data").Range("C" & startRow).Value
  79. Sheets("Show").Range("D" & RowCounter).Value = Sheets("Driving Data").Range("D" & startRow).Value
  80. Sheets("Show").Range("E" & RowCounter).Value = Sheets("Driving Data").Range("E" & startRow).Value
  81. Sheets("Show").Range("F" & RowCounter).Value = Sheets("Driving Data").Range("F" & startRow).Value
  82. Sheets("Show").Range("G" & RowCounter).Value = Sheets("Driving Data").Range("G" & startRow).Value
  83. Sheets("Show").Range("H" & RowCounter).Value = Sheets("Driving Data").Range("H" & startRow).Value
  84.  
  85. ' Add to total fee
  86. totalFee = totalFee + Sheets("Driving Data").Range("G" & startRow).Value
  87.  
  88. ' Check if we need to start a new page
  89. If (RowCounter - 63) Mod 40 = 0 Then
  90. ' Repeat headers on new page
  91. Sheets("Show").Rows("44:62").Copy
  92. Sheets("Show").Rows(RowCounter + 1).PasteSpecial Paste:=xlPasteFormats
  93. RowCounter = RowCounter + 18
  94. End If
  95.  
  96. RowCounter = RowCounter + 1
  97. startRow = startRow + 1
  98. Loop
  99.  
  100. ' Insert totals and VAT
  101. vat = totalFee * 0.17
  102. Sheets("Show").Range("E53").Value = totalFee
  103. Sheets("Show").Range("E56").Value = vat
  104. Sheets("Show").Range("E59").Value = totalFee + vat
  105.  
  106. ' Save the PDF for the first page (portrait)
  107. Sheets("Show").PageSetup.Orientation = xlPortrait
  108. Sheets("Show").PageSetup.PrintArea = "A1:I43"
  109. PdfFile = FolderPath & Name & "_1.pdf"
  110. Sheets("Show").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, _
  111. Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  112.  
  113. ' Save the PDF for the second page (landscape)
  114. Sheets("Show").PageSetup.Orientation = xlLandscape
  115. Sheets("Show").PageSetup.PrintArea = "A44:I88"
  116. PdfFile = FolderPath & Name & "_2.pdf"
  117. Sheets("Show").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, _
  118. Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  119. Next i
  120.  
  121. ' Clean up
  122. Set FSO = Nothing
  123. Application.CutCopyMode = False
  124. End Sub
  125.  
  126. Sub CreatePDFWithLandscapeMatrix()
  127. Dim wsData As Worksheet
  128. Dim wsShow As Worksheet
  129. Dim lastRow As Long
  130. Dim currentRow As Long
  131. Dim carID As String
  132. Dim carType As String
  133. Dim eventDate As String
  134. Dim entryGate As String
  135. Dim entryCount As String
  136. Dim fee As Double
  137. Dim totalFee As Double
  138. Dim vat As Double
  139. Dim pageNumber As Integer
  140.  
  141. Set wsData = ThisWorkbook.Sheets("Driving Data")
  142. Set wsShow = ThisWorkbook.Sheets("Show")
  143.  
  144. ' Ensure the Show sheet is set to landscape
  145. wsShow.PageSetup.Orientation = xlLandscape
  146.  
  147. ' Clear previous data
  148. wsShow.Range("A63:I" & wsShow.Rows.Count).ClearContents
  149.  
  150. lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
  151. currentRow = 63 ' Starting row for matrix data
  152. pageNumber = 1
  153. totalFee = 0
  154.  
  155. ' Loop through the data in Driving Data sheet
  156. For i = 7 To lastRow
  157. carID = wsData.Cells(i, "B").Value
  158. carType = wsData.Cells(i, "C").Value
  159. eventDate = wsData.Cells(i, "D").Value
  160. entryGate = wsData.Cells(i, "E").Value
  161. entryCount = wsData.Cells(i, "F").Value
  162. fee = wsData.Cells(i, "G").Value
  163.  
  164. ' Check if new page is needed
  165. If currentRow > 62 And (currentRow - 62) Mod 40 = 0 Then
  166. pageNumber = pageNumber + 1
  167. wsShow.HPageBreaks.Add Before:=wsShow.Cells(currentRow, 1)
  168. AddPageHeaders wsShow, currentRow
  169. currentRow = currentRow + 1
  170. End If
  171.  
  172. ' Add data to Show sheet
  173. wsShow.Cells(currentRow, "B").Value = carID
  174. wsShow.Cells(currentRow, "C").Value = carType
  175. wsShow.Cells(currentRow, "D").Value = eventDate
  176. wsShow.Cells(currentRow, "E").Value = entryGate
  177. wsShow.Cells(currentRow, "F").Value = entryCount
  178. wsShow.Cells(currentRow, "G").Value = fee
  179. wsShow.Cells(currentRow, "H").Value = fee * 0.17 ' Assuming VAT calculation is correct
  180. wsShow.Cells(currentRow, "I").Value = fee + (fee * 0.17)
  181.  
  182. totalFee = totalFee + fee
  183.  
  184. currentRow = currentRow + 1
  185. Next i
  186.  
  187. ' Add total fee, VAT, and sum to the specified cells
  188. wsShow.Cells(53, "E").Value = totalFee
  189. wsShow.Cells(56, "E").Value = totalFee * 0.17
  190. wsShow.Cells(60, "E").Value = totalFee + (totalFee * 0.17)
  191.  
  192. ' Save as PDF
  193. Dim pdfPath As String
  194. pdfPath = ThisWorkbook.Path & "\Output.pdf"
  195. wsShow.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, _
  196. IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  197. End Sub
  198.  
  199. Sub AddPageHeaders(ws As Worksheet, startRow As Long)
  200. ' Assuming headers are located at row 62 and need to be copied to each new page
  201. ws.Range("A62:I62").Copy
  202. ws.Range("A" & startRow & ":I" & startRow).PasteSpecial Paste:=xlPasteAll
  203. End Sub
  204.  
  205.  
  206.  
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!