API tools faq
paste
Advertisement
Guest User

Untitled

a guest
May 20th, 2018
92
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 14.56 KB | None | 0 0
raw download clone embed print report
  1. Sub mReports_Project_1()
  2. Dim stReportingTimeRaw As String
  3. Set ThisWb = ActiveWorkbook
  4. st_RPRT_Folder = "(1) Ìàòðèöà ñòðîêè äåêëàðàöèè - Îïåðàöèè"
  5. If bBulkReporting = False Then
  6. If MsgBox("Âû ñîáèðàåòåñü ñôîðìèðîâàòü îò÷åò:" _
  7. & Chr(10) _
  8. & Chr(10) _
  9. & "(1) Ìàòðèöà âçàèìîñâÿçè ñòðîê íàëîãîâûõ äåêëàðàöèé è õîçÿéñòâåííûõ îïåðàöèé, îòäåëüíûõ ýòàïîâ ÁÏ" _
  10. & Chr(10) _
  11. & Chr(10) _
  12. & Chr(10) _
  13. & "Ïðîäîëæèòü?", vbYesNo) <> vbYes Then
  14. Exit Sub
  15. End If
  16. End If
  17.  
  18. 'MsgBox ("REPORT")
  19.  
  20. '''''''''ÏÀÏÊÀ "Îò÷åòû SmartTemplate"
  21. If Not FolderExists(ThisWb.path & "\" & stReportFolder) Then
  22. FolderCreate ThisWb.path & "\" & stReportFolder 'Else MsgBox ("Ïàïêà óæå ñóùåñòâóåò")
  23. End If
  24. '''''''''ÏÀÏÊÀ "Ïðîåêòíûå îò÷åòû"
  25. If Not FolderExists(ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project) Then
  26. FolderCreate ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project
  27. End If
  28. '''''''''ÏÀÏÊÀ "#ÈÌß ÎÒ×åÒÀ"
  29. If Not FolderExists(ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project & "\" & st_RPRT_Folder) Then
  30. FolderCreate ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project & "\" & st_RPRT_Folder
  31. End If
  32.  
  33. 'ÑÎÇÄÀÒÜ ÏÀÏÊÓ "#ÄÀÒÀ ÎÒ×åÒÀ"
  34. If bBulkReporting = False Then
  35. stReportingTimeRaw = Now
  36. stReportingTime = strLegalFileName(stReportingTimeRaw)
  37. st_RPRT_Time_Folder = stReportingTime
  38. Else
  39. st_RPRT_Time_Folder = stBulkReportingTime
  40. End If
  41. If Not FolderExists(ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project & "\" & st_RPRT_Folder & "\" & st_RPRT_Time_Folder) Then
  42. FolderCreate ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project & "\" & st_RPRT_Folder & "\" & st_RPRT_Time_Folder
  43. End If
  44. '''''''''''''''''''''''''''''''''''''''''
  45. '''''''''''''''''''''''''''''''''''''''''
  46. 'ÑÎÇÄÀÒÜ ÎÒ×åÒ ÍÀ ÄÀÒÓ
  47. '''''''''''''''''''''''''''''''''''''''''
  48. '''''''''''''''''''''''''''''''''''''''''
  49. Prepare
  50. Set RprtWb = Workbooks.Add
  51. 'Îãðàíè÷åíèå 218 ñèìâîëîâ
  52. iErrLength218ExceedCount = 0
  53. stFullFolderPath = ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project & "\" & st_RPRT_Folder & "\" & st_RPRT_Time_Folder & "\"
  54. iFullFolderPath = Len(ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project & "\" & st_RPRT_Folder & "\" & st_RPRT_Time_Folder & "\")
  55. stFullFilePath = Left(ThisWb.path & "\" & stReportFolder & "\" & stReportFolder_Project & "\" & st_RPRT_Folder & "\" & st_RPRT_Time_Folder & "\" & st_RPRT_Folder, 186) & "... îò " & st_RPRT_Time_Folder & ".xlsx"
  56. If iFullFolderPath >= 187 Then
  57. iErrLength218ExceedCount = iErrLength218ExceedCount + 1
  58. RprtWb.Close
  59. Else
  60. 'Äåëàåì îò÷¸ò
  61. RprtWb.Activate
  62. Set RprtSht = ActiveSheet
  63. RprtSht.Name = st_RPRT_Time_Folder
  64.  
  65. 'lLastRow_rprt = ThisWb.Sheets("tt_CPRisk").Cells(Rows.Count, 2).End(xlUp).Row
  66. 'ThisWb.Sheets("tt_CPRisk").Range("A1:D" & lLastRow_rprt).Copy
  67. 'RprtWb.Sheets(RprtSht.Name).Range("A1").PasteSpecial (xlPasteValues)
  68.  
  69. RprtWb.Sheets(RprtSht.Name).Cells(3, 2).Value = "¹"
  70. RprtWb.Sheets(RprtSht.Name).Cells(3, 3).Value = "Ïðîöåññ 1 óðîâíÿ"
  71. RprtWb.Sheets(RprtSht.Name).Cells(3, 4).Value = "Ïðîöåññ 2 óðîâíÿ"
  72. RprtWb.Sheets(RprtSht.Name).Cells(3, 5).Value = "Ïîäïðîöåññ 3 óðîâíÿ"
  73. RprtWb.Sheets(RprtSht.Name).Cells(3, 6).Value = "Ïîäïðîöåññ 4 óðîâíÿ"
  74. RprtWb.Sheets(RprtSht.Name).Cells(3, 7).Value = "Äåêëàðàöèÿ"
  75. RprtWb.Sheets(RprtSht.Name).Cells(3, 8).Value = "Ëèñò"
  76. RprtWb.Sheets(RprtSht.Name).Cells(3, 9).Value = "Ïðèëîæåíèå"
  77. RprtWb.Sheets(RprtSht.Name).Cells(3, 10).Value = "Ñòðîêà"
  78. 'RprtWb.Sheets(RprtSht.Name).Cells(3, 10).Value = "Ñòàòóñ ïîêðûòèÿ"
  79.  
  80. iRprtLine = 4 'Ïåðâàÿ ñòðîêà îò÷¸òà
  81.  
  82. With ThisWb
  83. With .Sheets("ref_Operations")
  84. iProcessLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
  85. For iProcessElem = 5 To iProcessLastRow 'Ïî âñåì ïðîöåññàì
  86.  
  87. '(1)Ïèøåì â îò÷¸ò ñòðîêó
  88. ' (1.1) Èíèöèàëèçèðóåì ïåðåìåííûå
  89. stDecl_PROCESS_1 = .Cells(iProcessElem, 4).Value
  90. stDecl_PROCESS_2 = .Cells(iProcessElem, 5).Value
  91. stDecl_PROCESS_3 = .Cells(iProcessElem, 6).Value
  92. stDecl_PROCESS_4 = .Cells(iProcessElem, 7).Value
  93.  
  94. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 2).Value = iRprtLine - 3
  95. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 3).Value = stDecl_PROCESS_1
  96. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 4).Value = stDecl_PROCESS_2
  97. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 5).Value = stDecl_PROCESS_3
  98. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 6).Value = stDecl_PROCESS_4
  99. 'RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 6).Value = stDecl_STRING
  100. ' (1.2) Èùåì ÊÏ ó êîòîðûõ åñòü ýòîò ïðîöåññ
  101. iCPLastRow = ThisWb.Sheets("tt_CPOperations").Cells(Rows.Count, 2).End(xlUp).Row
  102. bCPtoRiskAdded = False
  103. For iCP = 4 To iCPLastRow
  104. If ThisWb.Sheets("tt_CPOperations").Cells(iCP, 3) = stDecl_PROCESS_1 _
  105. And ThisWb.Sheets("tt_CPOperations").Cells(iCP, 4) = stDecl_PROCESS_2 _
  106. And ThisWb.Sheets("tt_CPOperations").Cells(iCP, 5) = stDecl_PROCESS_3 _
  107. And ThisWb.Sheets("tt_CPOperations").Cells(iCP, 6) = stDecl_PROCESS_4 _
  108. Then
  109. 'Åñòü ÊÏ ó êîòîðûõ åñòü ýòîò ïðîöåññ
  110. 'Ïîëó÷àåì êîä ÊÏ â SmartTemplate
  111. stCP_CodeST = ThisWb.Sheets("tt_CPOperations").Cells(iCP, 2)
  112. 'stDecl_STRING = ThisWb.Sheets("tt_CPDeclHierarchy").Cells(iCP, 6)
  113. 'Äîáàâëÿåì çàïèñü â ñòðîêó îò÷¸òà
  114. ''''START ïîâòîðÿåì çàïèñè'''''
  115. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 2).Value = iRprtLine - 3
  116. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 3).Value = stDecl_PROCESS_1
  117. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 4).Value = stDecl_PROCESS_2
  118. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 5).Value = stDecl_PROCESS_3
  119. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 6).Value = stDecl_PROCESS_4
  120. ''''END ïîâòîðÿåì çàïèñè'''''
  121. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 7).Value = stCP_CodeST '"Äåêëàðàöèÿ"
  122. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 8).Value = "Ëèñò" '"Ñèñòåìíûé êîä ÊÏ"
  123. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 9).Value = "Ïðèëîæåíèå"
  124. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 10).Value = "Ñòðîêà"
  125. 'Èùåì ñòðîêè íàëîãîâîé äåêëàðàöèè ïî êîíòðîëþ, ó êîòîðîãî åñòü ïðîöåññ
  126. i_tt_CPDeclHierarchy_LastRow = ThisWb.Sheets("tt_CPDeclHierarchy").Cells(Rows.Count, 2).End(xlUp).Row
  127. For i_tt_CPDeclHierarchy_Current = 4 To i_tt_CPDeclHierarchy_LastRow
  128. If ThisWb.Sheets("tt_CPDeclHierarchy").Cells(i_tt_CPDeclHierarchy_Current, 2) = stCP_CodeST Then
  129. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 7).Value = ThisWb.Sheets("tt_CPDeclHierarchy").Cells(i_tt_CPDeclHierarchy_Current, 3).Value
  130. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 8).Value = ThisWb.Sheets("tt_CPDeclHierarchy").Cells(i_tt_CPDeclHierarchy_Current, 4).Value
  131. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 9).Value = ThisWb.Sheets("tt_CPDeclHierarchy").Cells(i_tt_CPDeclHierarchy_Current, 5).Value
  132. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 10).Value = ThisWb.Sheets("tt_CPDeclHierarchy").Cells(i_tt_CPDeclHierarchy_Current, 6).Value
  133. ''''START ïîâòîðÿåì çàïèñè''''''
  134. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 2).Value = iRprtLine - 3
  135. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 3).Value = stDecl_PROCESS_1
  136. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 4).Value = stDecl_PROCESS_2
  137. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 5).Value = stDecl_PROCESS_3
  138. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 6).Value = stDecl_PROCESS_4
  139. '''''END ïîâòîðÿåì çàïèñè''''''
  140. 'Ïåðåâîäèì íà íîâóþ ñòðîêó äëÿ íîâîé ñòðîêè äåêëàðàöèè ÊÏ
  141. iRprtLine = iRprtLine + 1
  142. bCPtoRiskAdded = True
  143. End If
  144. Next i_tt_CPDeclHierarchy_Current
  145.  
  146.  
  147. 'Ïåðåâîäèì íà íîâóþ ñòðîêó äëÿ íîâîé ÊÏ
  148. 'iRprtLine = iRprtLine + 1
  149. 'bCPtoRiskAdded = True
  150.  
  151.  
  152. End If
  153.  
  154. Next iCP
  155. 'Íåò ÊÏ ó êîòîðûõ åñòü ýòà îïåðàöèÿ
  156. If bCPtoRiskAdded = False Then
  157. 'Åñëè 4 óðîâåíü åñòü, íî íå íàéäåíà ÊÏ
  158. If .Cells(iProcessElem, 7).Value <> "" Then
  159. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 7).Value = "Íåò âëèÿíèÿ"
  160. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 8).Value = "-"
  161. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 9).Value = "-"
  162. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 10).Value = "-"
  163. End If
  164. 'Åñëè 4 óðîâíÿ íåò, òîãäà
  165. ''''3 óðîâåíü ëèáî àãðåãàöèîííûé ëèáî ïîñëåäíèé
  166. ''''''''Åñëè àãðåãàöèîííûé
  167. If .Cells(iProcessElem, 7).Value = "" Then
  168. If .Cells(iProcessElem, 6).Value <> "" _
  169. And .Cells(iProcessElem + 1, 6).Value <> .Cells(iProcessElem, 6).Value Then
  170. 'Êîíå÷íûé
  171. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 7).Value = "Íåò âëèÿíèÿ"
  172. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 8).Value = "-"
  173. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 9).Value = "-"
  174. RprtWb.Sheets(RprtSht.Name).Cells(iRprtLine, 10).Value = "-"
  175. Else
  176. 'àãðåãàöèîííûé
  177. End If
  178. End If
  179.  
  180.  
  181. iRprtLine = iRprtLine + 1
  182. End If
  183.  
  184. Next iProcessElem
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192. End With '
  193. End With 'ThisWb
  194.  
  195.  
  196.  
  197.  
  198. RprtWb.Sheets(RprtSht.Name).ListObjects.Add(xlSrcRange, Range("$B$3:$J$" & (3 + iProcessElem)), , xlYes).Name = "Project_1"
  199. ActiveSheet.ListObjects("Project_1").TableStyle = "TableStyleLight9"
  200.  
  201. RprtWb.Sheets(RprtSht.Name).Cells.RowHeight = 15
  202. RprtWb.SaveAs stFullFilePath
  203. RprtWb.Close
  204. End If
  205.  
  206. Ended
  207. '''''''''''''''''''''''''''''''''''''''''
  208. '''''''''''''''''''''''''''''''''''''''''
  209.  
  210. ThisWb.Sheets("MAIN").Unprotect Password:=stWorkbookPassword
  211.  
  212. If iErrLength218ExceedCount = 0 Then
  213. ThisWb.Sheets("MAIN").Hyperlinks.Add _
  214. Anchor:=ThisWb.Sheets("MAIN").Range("ref_cell_MAIN_REPORTS_Project_1_Link"), _
  215. Address:=stFullFilePath, _
  216. TextToDisplay:=st_RPRT_Folder & " îò " & st_RPRT_Time_Folder & ".xlsx"
  217. ThisWb.Sheets("MAIN").Range("ref_cell_MAIN_REPORTS_Project_1_Link").Offset(-2, 0).Value = iRprtLine - 3
  218. If bBulkReporting = False Then ThisWb.Sheets("MAIN").Cells(Range("ref_cell_MAIN_REPORTS_Project_1_Link").Row - 2, Range("ref_cell_MAIN_REPORTS_Project_1_Link").Column + 2) = stReportingTimeRaw
  219. If bBulkReporting = True Then ThisWb.Sheets("MAIN").Cells(Range("ref_cell_MAIN_REPORTS_Project_1_Link").Row - 2, Range("ref_cell_MAIN_REPORTS_Project_1_Link").Column + 2) = stBulkReportingTimeRaw
  220. ThisWb.Sheets("MAIN").Range("ref_cell_MAIN_REPORTS_Project_1_Link").Offset(-2, 2).Value = Environ("UserName")
  221. Else
  222. ThisWb.Sheets("MAIN").Range("ref_cell_MAIN_REPORTS_Project_1_Link").Value = "Îøèáêà ñîçäàíèÿ îò÷åòà: ïîëíûé ïóòü ôàéëà <" & stFullFilePath & "> ïðåâûøàåò 218 ñèìâîëîâ (ñèñòåìíîå îãðàíè÷åíèå). Ïîæàëóéñòà, âûáåðèòå áîëåå êîðîòêóþ äèðåêòîðèþ õðàíåíèÿ SmartTemplate è ïåðåçàïóñòèòå ôîðìèðîâàíèå îò÷åòîâ"
  223. ThisWb.Sheets("MAIN").Range("ref_cell_MAIN_REPORTS_Project_1_Link").Offset(-2, 0).Value = "-"
  224. If bBulkReporting = False Then ThisWb.Sheets("MAIN").Cells(Range("ref_cell_MAIN_REPORTS_Project_1_Link").Row - 2, Range("ref_cell_MAIN_REPORTS_Project_1_Link").Column + 2) = stReportingTimeRaw
  225. If bBulkReporting = True Then ThisWb.Sheets("MAIN").Cells(Range("ref_cell_MAIN_REPORTS_Project_1_Link").Row - 2, Range("ref_cell_MAIN_REPORTS_Project_1_Link").Column + 2) = stBulkReportingTimeRaw
  226. ThisWb.Sheets("MAIN").Range("ref_cell_MAIN_REPORTS_Project_1_Link").Offset(-2, 4).Value = Environ("UserName")
  227. End If
  228.  
  229. ThisWb.Sheets("MAIN").Protect Password:=stWorkbookPassword, UserInterfaceOnly:=True
  230.  
  231. If bBulkReporting = False Then MsgBox ("Îò÷¸ò ñôîðìèðîâàí")
  232. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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!