Created
November 2, 2013 21:07
-
-
Save zv0r/7283525 to your computer and use it in GitHub Desktop.
Проверка параграфа
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Dim conn As ADODB.Connection | |
| Dim rs As ADODB.Recordset | |
| Dim rsFundData As ADODB.Recordset | |
| Dim rsFundStats As ADODB.Recordset | |
| Dim rsInventoryData As ADODB.Recordset | |
| Dim rsInventoryStats As ADODB.Recordset | |
| Dim rsInventoriesWithPdf As ADODB.Recordset | |
| Dim rsInventoriesWithPdfCount As ADODB.Recordset | |
| Dim rsFilledIsnInventory As ADODB.Recordset | |
| Dim totalInventories As Integer | |
| Private Sub ConnectSqlServer() | |
| Dim sConnString As String | |
| ' Create the connection string. | |
| sConnString = "Provider=SQLOLEDB;Data Source=winserver2008;" & _ | |
| "Initial Catalog=ArchiveFund5;" & _ | |
| "Integrated Security=SSPI;" | |
| ' Create the Connection and Recordset objects. | |
| Set conn = New ADODB.Connection | |
| Set rs = New ADODB.Recordset | |
| rs.CursorLocation = adUseClient | |
| ' Open the connection and execute. | |
| conn.Open sConnString | |
| End Sub | |
| ' Удаляет все содержимое документа | |
| Private Sub PrepareDocument() | |
| Selection.WholeStory | |
| Selection.TypeBackspace | |
| Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify | |
| Selection.Font.Name = "Times New Roman" | |
| Selection.Font.Size = 14 | |
| With Selection.ParagraphFormat | |
| .LeftIndent = CentimetersToPoints(0) | |
| .RightIndent = CentimetersToPoints(0) | |
| .SpaceBefore = 0 | |
| .SpaceBeforeAuto = False | |
| .SpaceAfter = 0 | |
| .SpaceAfterAuto = False | |
| .LineSpacingRule = wdLineSpaceMultiple | |
| .LineSpacing = LinesToPoints(1.15) | |
| .Alignment = wdAlignParagraphJustify | |
| .WidowControl = True | |
| .KeepWithNext = False | |
| .KeepTogether = False | |
| .PageBreakBefore = False | |
| .NoLineNumber = False | |
| .Hyphenation = True | |
| .FirstLineIndent = CentimetersToPoints(0) | |
| .OutlineLevel = wdOutlineLevelBodyText | |
| .CharacterUnitLeftIndent = 0 | |
| .CharacterUnitRightIndent = 0 | |
| .CharacterUnitFirstLineIndent = 0 | |
| .LineUnitBefore = 0 | |
| .LineUnitAfter = 0 | |
| .MirrorIndents = False | |
| .TextboxTightWrap = wdTightNone | |
| End With | |
| End Sub | |
| ' Показывает текст загрузки | |
| Private Sub LoadingText() | |
| MsgBox "Сейчас начнется обработка данных. Не закрывайте документ и ничего не печатайте. Нажмите ОК.", vbExclamation | |
| End Sub | |
| Private Sub FinishText() | |
| MsgBox "Обработка данных закончена. Можете сохранить или распечатать отчет.", vbInformation | |
| End Sub | |
| ' Пишет, сколько всего записей внес параграф | |
| Private Sub ShowTotalRecords() | |
| Set rs = conn.Execute("SELECT COUNT(*) as count FROM tblUNIT " & _ | |
| "WHERE NOTE LIKE '%параграф%' and Deleted <> 1;") | |
| ' Проверить, что есть данные | |
| If Not rs.EOF Then | |
| rs.MoveFirst | |
| totalRecords = rs![Count].value | |
| End If | |
| ' Закрыть рекордсет | |
| rs.Close | |
| ' Запишем в ворд | |
| Selection.TypeText Text:="В общей сложности введено единиц хранения: " | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=totalRecords & "." | |
| Selection.TypeParagraph | |
| Selection.Font.Bold = False | |
| End Sub | |
| Private Sub ShowRecordsInInventoriesAndFunds() | |
| ' во сколько описей вносились заголовки | |
| Set rs = conn.Execute("SELECT TOP 1 COUNT(*) OVER() as Count FROM tblUNIT " & _ | |
| "WHERE NOTE LIKE '%параграф%' and Deleted <> 1 GROUP BY ISN_INVENTORY;") | |
| ' Проверить, что есть данные | |
| If Not rs.EOF Then | |
| rs.MoveFirst | |
| totalInventories = rs![Count].value | |
| End If | |
| ' Закрыть рекордсет | |
| rs.Close | |
| ' во сколько фондов заносились заголовки | |
| Set rs = conn.Execute("SELECT TOP 1 COUNT(*) OVER() as Count FROM tblINVENTORY WHERE " & _ | |
| "ISN_INVENTORY IN (SELECT ISN_INVENTORY FROM tblUNIT WHERE NOTE LIKE " & _ | |
| "'%параграф%' and Deleted <> 1 GROUP BY ISN_INVENTORY) GROUP BY ISN_FUND;") | |
| ' Проверить, что есть данные | |
| If Not rs.EOF Then | |
| rs.MoveFirst | |
| totalFunds = rs![Count].value | |
| End If | |
| ' Закрыть рекордсет | |
| rs.Close | |
| ' Вывести инфу в ворд | |
| Selection.TypeText Text:="Записи введены в " | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=totalInventories | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=" описей в " | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=totalFunds | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=" фондах." | |
| Selection.TypeParagraph | |
| End Sub | |
| Private Sub ShowFilledFunds() | |
| ' Вычислить ID фондов, в которые заносились записи | |
| Set rs = conn.Execute("SELECT ISN_FUND FROM tblINVENTORY WHERE " & _ | |
| "ISN_INVENTORY IN (SELECT ISN_INVENTORY FROM tblUNIT WHERE NOTE LIKE " & _ | |
| "'%параграф%' and Deleted <> 1 GROUP BY ISN_INVENTORY) GROUP BY ISN_FUND;") | |
| ' Нарисовать шапку, если в выборке были результаты | |
| If Not rs.EOF Then | |
| Selection.TypeParagraph | |
| ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _ | |
| 3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ | |
| wdAutoFitFixed | |
| With Selection.Tables(1) | |
| If .Style <> "Сетка таблицы" Then | |
| .Style = "Сетка таблицы" | |
| End If | |
| .ApplyStyleHeadingRows = True | |
| .ApplyStyleLastRow = False | |
| .ApplyStyleFirstColumn = True | |
| .ApplyStyleLastColumn = False | |
| .ApplyStyleRowBands = True | |
| .ApplyStyleColumnBands = False | |
| End With | |
| Selection.TypeText Text:="номер" | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="фонда" | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.TypeText Text:="ед.хр. в" | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="итоговой записи" | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.TypeText Text:="введено" | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="ед.хр." | |
| Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend | |
| Selection.MoveLeft Unit:=wdCharacter, Count:=7, Extend:=wdExtend | |
| Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter | |
| Selection.Font.Bold = True | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.MoveLeft Unit:=wdCharacter, Count:=1 | |
| End If | |
| ' Пройтись по найденным фондам | |
| rs.MoveFirst | |
| While Not rs.EOF | |
| currentIsnFund = rs![ISN_FUND].value | |
| ' Выудить номер фонда | |
| Set rsFundData = conn.Execute("SELECT TOP 1 FUND_NUM_2 FROM tblFUND WHERE ISN_FUND = " & CStr(currentIsnFund) & ";") | |
| rsFundData.MoveFirst | |
| currentFundNum = rsFundData![FUND_NUM_2].value | |
| rsFundData.Close | |
| Set rsFundStats = conn.Execute("SELECT UNIT_COUNT, UNIT_REGISTERED FROM tblDOCUMENT_STATS where ISN_FUND=" & _ | |
| currentIsnFund & " and CARRIER_TYPE IS NULL and ISN_INVENTORY IS NULL;") | |
| currentUnitCount = rsFundStats![UNIT_COUNT].value | |
| currentUnitRegistered = rsFundStats![UNIT_REGISTERED].value | |
| ''' Рисование строки с вытащенными данными | |
| Selection.InsertRowsBelow 1 | |
| Selection.MoveLeft Unit:=wdCharacter, Count:=1 | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=currentFundNum | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=currentUnitCount | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=currentUnitRegistered | |
| ''' Нарисовал строку | |
| rsFundStats.Close | |
| rs.MoveNext | |
| Wend | |
| ' Закрыть рекордсет | |
| rs.Close | |
| ' Убрать курсор из таблицы | |
| Selection.MoveDown Unit:=wdLine, Count:=1 | |
| End Sub | |
| Private Sub ShowFilledInventories() | |
| ' Вычислить ID описей, в которые заносились записи | |
| Set rsFilledIsnInventory = conn.Execute("SELECT ISN_INVENTORY FROM tblUNIT WHERE NOTE " & _ | |
| "LIKE '%параграф%' and Deleted <> 1 GROUP BY ISN_INVENTORY;") | |
| ' Нарисовать шапку, если в выборке были результаты | |
| If Not rsFilledIsnInventory.EOF Then | |
| Selection.TypeParagraph | |
| ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _ | |
| 4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ | |
| wdAutoFitFixed | |
| With Selection.Tables(1) | |
| If .Style <> "Сетка таблицы" Then | |
| .Style = "Сетка таблицы" | |
| End If | |
| .ApplyStyleHeadingRows = True | |
| .ApplyStyleLastRow = False | |
| .ApplyStyleFirstColumn = True | |
| .ApplyStyleLastColumn = False | |
| .ApplyStyleRowBands = True | |
| .ApplyStyleColumnBands = False | |
| End With | |
| Selection.TypeText Text:="номер" | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="фонда" | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.TypeText Text:="номер" | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="описи" | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.TypeText Text:="ед.хр. в" | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="итоговой записи" | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.TypeText Text:="введено" | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="ед.хр." | |
| Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend | |
| Selection.MoveLeft Unit:=wdCharacter, Count:=8, Extend:=wdExtend | |
| Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter | |
| Selection.Font.Bold = True | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.MoveLeft Unit:=wdCharacter, Count:=1 | |
| End If | |
| ' Пройтись по найденным описям | |
| rsFilledIsnInventory.MoveFirst | |
| While Not rsFilledIsnInventory.EOF | |
| currentIsnInventory = rsFilledIsnInventory![ISN_INVENTORY].value | |
| ' Выудить номер описи | |
| Set rsInventoryData = conn.Execute("SELECT TOP 1 ISN_FUND, INVENTORY_NUM_1, INVENTORY_NUM_3 FROM tblINVENTORY WHERE ISN_INVENTORY = " & CStr(currentIsnInventory) & ";") | |
| rsInventoryData.MoveFirst | |
| currentInventoryNum = rsInventoryData![INVENTORY_NUM_1].value | |
| If Not IsEmpty(rsInventoryData![INVENTORY_NUM_3].value) And rsInventoryData![INVENTORY_NUM_3].value <> "" Then | |
| currentInventoryPart = " т. " & rsInventoryData![INVENTORY_NUM_3].value | |
| Else | |
| currentInventoryPart = "" | |
| End If | |
| currentInventoryIsnFund = rsInventoryData![ISN_FUND].value | |
| rsInventoryData.Close | |
| ' Выудить номер фонда | |
| Set rsFundData = conn.Execute("SELECT TOP 1 FUND_NUM_2 FROM tblFUND WHERE ISN_FUND = " & CStr(currentInventoryIsnFund) & ";") | |
| rsFundData.MoveFirst | |
| currentInventoryFundNum = rsFundData![FUND_NUM_2].value | |
| rsFundData.Close | |
| Set rsInventoryStats = conn.Execute("SELECT UNIT_COUNT, UNIT_REGISTERED FROM tblDOCUMENT_STATS where ISN_INVENTORY=" & _ | |
| currentIsnInventory & " and CARRIER_TYPE IS NULL;") | |
| currentUnitCount = rsInventoryStats![UNIT_COUNT].value | |
| currentUnitRegistered = rsInventoryStats![UNIT_REGISTERED].value | |
| ''' Рисование строки с вытащенными данными | |
| Selection.InsertRowsBelow 1 | |
| Selection.MoveLeft Unit:=wdCharacter, Count:=1 | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=currentInventoryFundNum | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=currentInventoryNum | |
| Selection.TypeText Text:=currentInventoryPart | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=currentUnitCount | |
| Selection.MoveRight Unit:=wdCharacter, Count:=1 | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=currentUnitRegistered | |
| ''' Нарисовал строку | |
| 'rsInventoryStats.Close | |
| rsFilledIsnInventory.MoveNext | |
| Wend | |
| ' Потом этот рекордсет будет еще использоваться, так что вернем курсор на первую позицию | |
| rsFilledIsnInventory.MoveFirst | |
| ' Убрать курсор из таблицы | |
| Selection.MoveDown Unit:=wdLine, Count:=1 | |
| End Sub | |
| Private Sub ShowInventoriesWithoutPdf() | |
| Dim i As Integer | |
| Dim j As Integer | |
| Dim k As Integer | |
| Dim l As Integer | |
| Dim isFound As Boolean | |
| ' Массив с ID описей, внесенными параграфом | |
| Dim arrInventoriesOverall() As String | |
| ' Массив с ID описей, внесенных параграфом и к которым прикреплены pdf | |
| Dim arrInventoriesWithPdf() As String | |
| ' ID описей, внесенных параграфом и к которым не прикреплены pdf, строка, | |
| ' потому что потом это дело засунется в SQL запрос | |
| Dim InventoriesWoPdf As String | |
| ' Вычислить количество карточек описей с прикрепленными pdf-ками | |
| Set rsInventoriesWithPdfCount = conn.Execute("SELECT top 1 COUNT(*) OVER() as Count FROM tblREF_FILE where ISN_OBJ IN " & _ | |
| "(SELECT ISN_INVENTORY FROM tblUNIT WHERE NOTE LIKE '%параграф%' " & _ | |
| "and Deleted <> 1 GROUP BY ISN_INVENTORY) GROUP BY ISN_OBJ;") | |
| currentPdfCount = rsInventoriesWithPdfCount![Count].value | |
| rsInventoriesWithPdfCount.Close | |
| ' Вычислить ID описей с прикрепленными pdf файлами | |
| Set rsInventoriesWithPdf = conn.Execute("SELECT ISN_OBJ FROM tblREF_FILE where ISN_OBJ IN " & _ | |
| "(SELECT ISN_INVENTORY FROM tblUNIT WHERE NOTE LIKE '%параграф%' " & _ | |
| "and Deleted <> 1 GROUP BY ISN_INVENTORY) GROUP BY ISN_OBJ;") | |
| ' Преобразовать recordset в массив | |
| If Not rsInventoriesWithPdf.EOF Then | |
| k = 0 | |
| rsInventoriesWithPdf.MoveFirst | |
| While Not rsInventoriesWithPdf.EOF | |
| ReDim Preserve arrInventoriesWithPdf(k) | |
| arrInventoriesWithPdf(k) = rsInventoriesWithPdf![ISN_OBJ].value | |
| k = k + 1 | |
| rsInventoriesWithPdf.MoveNext | |
| Wend | |
| End If | |
| rsInventoriesWithPdf.Close | |
| ' Преобразовать recordset с найденными раньше ID описей, внесенных параграфом, в массив | |
| If Not rsFilledIsnInventory.EOF Then | |
| k = 0 | |
| rsFilledIsnInventory.MoveFirst | |
| While Not rsFilledIsnInventory.EOF | |
| ReDim Preserve arrInventoriesOverall(k) | |
| arrInventoriesOverall(k) = rsFilledIsnInventory![ISN_INVENTORY].value | |
| k = k + 1 | |
| rsFilledIsnInventory.MoveNext | |
| Wend | |
| End If | |
| ' Вычислить ID описей, к которым не прикреплены pdf | |
| l = 0 | |
| InventoriesWoPdf = "" | |
| For i = 0 To UBound(arrInventoriesOverall) | |
| isFound = False | |
| For j = 0 To UBound(arrInventoriesWithPdf) | |
| If arrInventoriesOverall(i) = arrInventoriesWithPdf(j) Then | |
| isFound = True | |
| End If | |
| Next 'j | |
| If Not isFound Then | |
| If InventoriesWoPdf <> "" Then | |
| InventoriesWoPdf = InventoriesWoPdf & ", " & arrInventoriesOverall(i) | |
| Else | |
| InventoriesWoPdf = arrInventoriesOverall(i) | |
| End If | |
| l = l + 1 | |
| End If | |
| Next i | |
| Set rsWoPdfInfo = conn.Execute("select tblFund.FUND_NUM_2, tblINVENTORY.INVENTORY_NUM_1, tblINVENTORY.INVENTORY_NUM_3 from tblInventory, tblFUND where tblInventory.isn_inventory IN (" & InventoriesWoPdf & ") and tblFund.ISN_FUND = tblINVENTORY.ISN_FUND;") | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="Из " | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=totalInventories & " " | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:="описей pdf файлы прикреплены к " | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=currentPdfCount | |
| Selection.Font.Bold = False | |
| Selection.TypeText Text:=" карточкам." | |
| If Not rsWoPdfInfo.EOF Then | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="Карточки описей, к которым не прикреплены PDF файлы:" | |
| rsWoPdfInfo.MoveFirst | |
| While Not rsWoPdfInfo.EOF | |
| Selection.TypeParagraph | |
| Selection.TypeText Text:="ф. " & rsWoPdfInfo![FUND_NUM_2].value & " оп. " & rsWoPdfInfo![INVENTORY_NUM_1].value | |
| If Not IsEmpty(rsWoPdfInfo![INVENTORY_NUM_3].value) And rsWoPdfInfo![INVENTORY_NUM_3].value <> "" And rsWoPdfInfo![INVENTORY_NUM_3].value <> 0 Then | |
| Selection.TypeText Text:=" т. " & rsWoPdfInfo![INVENTORY_NUM_3].value | |
| End If | |
| rsWoPdfInfo.MoveNext | |
| Wend | |
| End If | |
| Selection.TypeParagraph | |
| rsWoPdfInfo.Close | |
| End Sub | |
| ' Вычисляет, в каких описях, введенных параграфом, пропущены заголовки | |
| Private Sub ShowInventoriesWithMissingNumbers() | |
| Dim i As Integer | |
| Dim rsUnitsInfo As ADODB.Recordset | |
| ' Номер фонда, номер и том описи | |
| Dim rsInventoryInfo As ADODB.Recordset | |
| ' Пропущенные заголовки в описи | |
| Dim missedUnitsIndex As Integer | |
| Dim missedUnits() As Integer | |
| ' Пропущенные заголовки в описи, только в человеческом формате, | |
| ' диапазонами, а не сплошной нумерацией | |
| Dim missedUnitsS As String | |
| Dim CutFrom, CutDiff As Integer | |
| ' Логично, что пропуски в заголовках нужно искать, если описи ввели. | |
| rsFilledIsnInventory.MoveFirst | |
| If Not rsFilledIsnInventory.EOF Then | |
| Selection.TypeParagraph | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineSingle | |
| Selection.TypeText Text:="Описи, в которых пропущены номера единиц хранения" | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineNone | |
| ' Изначально считаем, что пропущенных номеров нет | |
| noMissingNumbers = True | |
| ' Пройдемся по каждой описи | |
| While Not rsFilledIsnInventory.EOF | |
| Set rsUnitsInfo = conn.Execute("SELECT COUNT(*) OVER() as Count, cast(UNIT_NUM_1 as int) as UNIT_NUM_1 from tblUNIT where ISN_INVENTORY=" & rsFilledIsnInventory![ISN_INVENTORY].value & " and Deleted = 0 AND (UNIT_NUM_2 IS NULL OR UNIT_NUM_2 = '') GROUP BY UNIT_NUM_1 ORDER BY UNIT_NUM_1 DESC;") | |
| CutFrom = 0 | |
| If Not rsUnitsInfo.EOF Then | |
| rsUnitsInfo.MoveFirst | |
| ' Задать размер массиву с пропущенными заголовками | |
| missedUnitsIndex = rsUnitsInfo![UNIT_NUM_1].value - rsUnitsInfo![Count].value | |
| ReDim Preserve missedUnits(missedUnitsIndex) | |
| ' Строковый вариант пропущенных заголовков опустошить | |
| missedUnitsS = "" | |
| ' Ни к чему прогонять тысячи записей, если в них не пропущена нумерация | |
| If missedUnitsIndex > 0 Then | |
| MoreUnitsForProcessing = 0 | |
| While Not rsUnitsInfo.EOF | |
| MoreUnitsForProcessing = rsUnitsInfo![UNIT_NUM_1].value - 1 | |
| If CutFrom <> 0 And CutFrom > rsUnitsInfo![UNIT_NUM_1].value Then | |
| ' Сколько выйдет в результате вычитания, столько номеров пропущено | |
| CutDiff = CutFrom - rsUnitsInfo![UNIT_NUM_1].value - 1 | |
| ' Если больше нуля, значит, есть пропущенные | |
| If CutDiff > 0 Then | |
| ' Дополнить строковую переменную диапазоном пропущенных заголовков | |
| ' ну или одним заголовком | |
| If CutDiff = 1 Then | |
| missedUnitsS = rsUnitsInfo![UNIT_NUM_1].value + 1 & ", " & missedUnitsS | |
| Else | |
| missedUnitsS = rsUnitsInfo![UNIT_NUM_1].value + 1 & "-" & CutFrom - 1 & ", " & missedUnitsS | |
| End If | |
| noMissingNumbers = False | |
| For i = CutFrom - 1 To CutFrom - CutDiff Step -1 | |
| missedUnits(missedUnitsIndex - 1) = i | |
| missedUnitsIndex = missedUnitsIndex - 1 | |
| Next i | |
| End If | |
| End If | |
| ' На следующей итерации будем вычитать из текущего номера единицы хранения | |
| CutFrom = rsUnitsInfo![UNIT_NUM_1].value | |
| rsUnitsInfo.MoveNext | |
| Wend | |
| ' Если список дел начинается не с первого номера, автоматически дозаполнить | |
| ' список пропущенных заголовков до единицы | |
| If MoreUnitsForProcessing > 0 Then | |
| If MoreUnitsForProcessing = 1 Then | |
| missedUnitsS = "1, " & missedUnitsS | |
| Else | |
| missedUnitsS = "1-" & MoreUnitsForProcessing & ", " & missedUnitsS | |
| End If | |
| While Not MoreUnitsForProcessing = 0 | |
| missedUnits(missedUnitsIndex - 1) = MoreUnitsForProcessing | |
| missedUnitsIndex = missedUnitsIndex - 1 | |
| MoreUnitsForProcessing = MoreUnitsForProcessing - 1 | |
| Wend | |
| End If | |
| End If | |
| ' Если есть пропущенные заголовки, получим информацию о фонде и описи | |
| ' и выведем список пропущенных заголовков | |
| If UBound(missedUnits) > 0 Then | |
| Set rsInventoryInfo = conn.Execute("select top 1 tblFund.FUND_NUM_2, tblINVENTORY.INVENTORY_NUM_1, tblINVENTORY.INVENTORY_NUM_3 from tblInventory, tblFUND where tblInventory.isn_inventory = " & rsFilledIsnInventory![ISN_INVENTORY] & " and tblFund.ISN_FUND = tblINVENTORY.ISN_FUND;") | |
| If Not rsInventoryInfo.EOF Then | |
| Selection.TypeParagraph | |
| Selection.TypeParagraph | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:="ф. " & rsInventoryInfo![FUND_NUM_2] | |
| Selection.TypeText Text:=" оп. " & rsInventoryInfo![INVENTORY_NUM_1] | |
| If Not IsEmpty(rsInventoryInfo![INVENTORY_NUM_3].value) And rsInventoryInfo![INVENTORY_NUM_3].value <> "" Then | |
| Selection.TypeText Text:=" т. " & rsInventoryInfo![INVENTORY_NUM_3].value | |
| End If | |
| Selection.TypeText Text:=" (пропущено " & UBound(missedUnits) & "): " | |
| Selection.Font.Bold = False | |
| ' Раскомментировать, если нужно вывести числовой вариант списка | |
| 'For missedUnitNum = 0 To UBound(missedUnits) - 1 | |
| ' Selection.TypeText Text:=missedUnits(missedUnitNum) & ", " | |
| 'Next missedUnitNum | |
| Selection.TypeText Text:=missedUnitsS | |
| Selection.TypeBackspace | |
| Selection.TypeBackspace | |
| End If | |
| End If | |
| End If | |
| rsUnitsInfo.Close | |
| rsFilledIsnInventory.MoveNext | |
| Wend | |
| If noMissingNumbers Then | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=" отсутствуют" | |
| Selection.Font.Bold = False | |
| End If | |
| End If | |
| End Sub | |
| Private Sub ShowInventoriesWithLetterUnits() | |
| ' Список единиц хранения с литерными номерами | |
| Dim rsInventoriesWithLetterUnits As ADODB.Recordset | |
| ' Флаг, указывающий на отсутствие литерных заголовков | |
| Dim noLetterNumbers As Boolean | |
| ' Идентификатор записанного ранее заголовка. Содержит номер фонда, | |
| ' описи и тома. Используется, если надо начать новый абзац | |
| Dim prevNumIdentifier As String | |
| ' Идентификатор текущего заголовка. Содержит номер фонда, | |
| ' описи и тома. Используется для сравнения с параметром prevNumIdentifier | |
| Dim currNumIdentifier As String | |
| ' Собственно, список литерных заголовков описи | |
| Dim unitsList As String | |
| ' Получить список единиц хранения с литерными номерами | |
| Set rsInventoriesWithLetterUnits = conn.Execute( _ | |
| "SELECT" & _ | |
| " cast (tblFUND.FUND_NUM_2 as int) AS FUND_NUM_2," & _ | |
| " cast (tblINVENTORY.INVENTORY_NUM_1 as int) AS INVENTORY_NUM_1," & _ | |
| " cast (tblINVENTORY.INVENTORY_NUM_3 as int) AS INVENTORY_NUM_3," & _ | |
| " cast (tblUNIT.UNIT_NUM_1 as int) AS UNIT_NUM_1," & _ | |
| " tblUNIT.UNIT_NUM_2 " & _ | |
| "FROM tblUNIT, tblINVENTORY, tblFUND " & _ | |
| "WHERE" & _ | |
| " (tblUNIT.UNIT_NUM_2 IS NOT NULL AND tblUNIT.UNIT_NUM_2 <> '')" & _ | |
| " AND tblUNIT.Deleted <> 1" & _ | |
| " AND tblUNIT.NOTE LIKE '%параграф%'" & _ | |
| " AND tblUNIT.ISN_INVENTORY = tblINVENTORY.ISN_INVENTORY" & _ | |
| " AND tblINVENTORY.ISN_FUND = tblFUND.ISN_FUND " & _ | |
| "ORDER BY" & _ | |
| " FUND_NUM_2 ASC," & _ | |
| " INVENTORY_NUM_1 ASC," & _ | |
| " INVENTORY_NUM_3 ASC," & _ | |
| " UNIT_NUM_1 ASC," & _ | |
| " UNIT_NUM_2 ASC;") | |
| Selection.TypeParagraph | |
| Selection.TypeParagraph | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineSingle | |
| Selection.TypeText Text:="Описи, в которых присутствуют литерные номера единиц хранения " | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineNone | |
| ' Изначально считаем, что литерных номеров нет | |
| noLetterNumbers = True | |
| ' Пока ни одного заголовка не посмотрели, так что | |
| ' иденификатор предыдущего заголовка пустой | |
| prevNumIdentifier = "" | |
| unitsList = "" | |
| rsInventoriesWithLetterUnits.MoveFirst | |
| If Not rsInventoriesWithLetterUnits.EOF Then | |
| ' Если есть результат запроса, значит есть литерные заголовки. | |
| ' Установим флаг в false, чтобы не вывелась запись об отсутствии | |
| noLetterNumbers = False | |
| While Not rsInventoriesWithLetterUnits.EOF | |
| If Not IsEmpty(rsInventoriesWithLetterUnits![INVENTORY_NUM_3].value) And rsInventoriesWithLetterUnits![INVENTORY_NUM_3].value <> "" Then | |
| currNumIdentifier = CStr(rsInventoriesWithLetterUnits![FUND_NUM_2]) & "." & _ | |
| CStr(rsInventoriesWithLetterUnits![INVENTORY_NUM_1]) & "." & _ | |
| CStr(rsInventoriesWithLetterUnits![INVENTORY_NUM_3]) | |
| Else | |
| currNumIdentifier = CStr(rsInventoriesWithLetterUnits![FUND_NUM_2]) & "." & _ | |
| CStr(rsInventoriesWithLetterUnits![INVENTORY_NUM_1]) | |
| End If | |
| ' Если текущий и предыдущий идентификаторы не совпадают, | |
| ' выведем вычисленный список литерных заголовков в текущей описи | |
| If currNumIdentifier <> prevNumIdentifier Then | |
| ' выводим список, только если он есть | |
| ' и сразу очищаем | |
| Selection.TypeText Text:=unitsList | |
| unitsList = "" | |
| ' записать новый номер описи, предварительно убрав две запятые в конце списка заголовков | |
| Selection.TypeBackspace | |
| Selection.TypeBackspace | |
| Selection.TypeParagraph | |
| Selection.TypeParagraph | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:="ф. " & rsInventoriesWithLetterUnits![FUND_NUM_2] | |
| Selection.TypeText Text:=" оп. " & rsInventoriesWithLetterUnits![INVENTORY_NUM_1] | |
| If Not IsEmpty(rsInventoriesWithLetterUnits![INVENTORY_NUM_3].value) And rsInventoriesWithLetterUnits![INVENTORY_NUM_3].value <> "" And rsInventoriesWithLetterUnits![INVENTORY_NUM_3].value <> 0 Then | |
| Selection.TypeText Text:=" т. " & rsInventoriesWithLetterUnits![INVENTORY_NUM_3].value | |
| End If | |
| Selection.TypeText Text:=": " | |
| Selection.Font.Bold = False | |
| ' сменить идентификатор на текущий | |
| prevNumIdentifier = currNumIdentifier | |
| End If | |
| unitsList = unitsList & rsInventoriesWithLetterUnits![UNIT_NUM_1] & rsInventoriesWithLetterUnits![UNIT_NUM_2] & ", " | |
| rsInventoriesWithLetterUnits.MoveNext | |
| Wend | |
| ' Вывести последний список литерных заголовков | |
| Selection.TypeText Text:=unitsList | |
| Selection.TypeBackspace | |
| Selection.TypeBackspace | |
| End If | |
| If noLetterNumbers Then | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=" отсутствуют" | |
| Selection.Font.Bold = False | |
| End If | |
| ' Закрыть рекордсет | |
| rsInventoriesWithLetterUnits.Close | |
| End Sub | |
| Private Sub ShowInventoriesWithLostUnits() | |
| ' Список единиц хранения с выбывшими номерами | |
| Dim rsInventoriesWithLostUnits As ADODB.Recordset | |
| ' Флаг, указывающий на отсутствие выбывших заголовков | |
| Dim noLostNumbers As Boolean | |
| ' Идентификатор записанного ранее заголовка. Содержит номер фонда, | |
| ' описи и тома. Используется, если надо начать новый абзац | |
| Dim prevNumIdentifier As String | |
| ' Идентификатор текущего заголовка. Содержит номер фонда, | |
| ' описи и тома. Используется для сравнения с параметром prevNumIdentifier | |
| Dim currNumIdentifier As String | |
| ' Собственно, список выбывших заголовков описи | |
| Dim unitsList As String | |
| ' Получить список единиц хранения с выбывшими номерами | |
| Set rsInventoriesWithLostUnits = conn.Execute( _ | |
| "SELECT" & _ | |
| " cast (tblFUND.FUND_NUM_2 as int) AS FUND_NUM_2," & _ | |
| " cast (tblINVENTORY.INVENTORY_NUM_1 as int) AS INVENTORY_NUM_1," & _ | |
| " cast (tblINVENTORY.INVENTORY_NUM_3 as int) AS INVENTORY_NUM_3," & _ | |
| " cast (tblUNIT.UNIT_NUM_1 as int) AS UNIT_NUM_1," & _ | |
| " tblUNIT.UNIT_NUM_2 " & _ | |
| "FROM tblUNIT, tblINVENTORY, tblFUND " & _ | |
| "WHERE" & _ | |
| " tblUNIT.IS_LOST = 'Y'" & _ | |
| " AND tblUNIT.Deleted <> 1" & _ | |
| " AND tblUNIT.NOTE LIKE '%параграф%'" & _ | |
| " AND tblUNIT.ISN_INVENTORY = tblINVENTORY.ISN_INVENTORY" & _ | |
| " AND tblINVENTORY.ISN_FUND = tblFUND.ISN_FUND " & _ | |
| "ORDER BY" & _ | |
| " FUND_NUM_2 ASC," & _ | |
| " INVENTORY_NUM_1 ASC," & _ | |
| " INVENTORY_NUM_3 ASC," & _ | |
| " UNIT_NUM_1 ASC," & _ | |
| " UNIT_NUM_2 ASC;") | |
| Selection.TypeParagraph | |
| Selection.TypeParagraph | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineSingle | |
| Selection.TypeText Text:="Описи, в которых присутствуют выбывшие единицы хранения " | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineNone | |
| ' Изначально считаем, что выбывших номеров нет | |
| noLostNumbers = True | |
| ' Пока ни одного заголовка не посмотрели, так что | |
| ' иденификатор предыдущего заголовка пустой | |
| prevNumIdentifier = "" | |
| unitsList = "" | |
| If Not rsInventoriesWithLostUnits.EOF Then | |
| rsInventoriesWithLostUnits.MoveFirst | |
| ' Если есть результат запроса, значит есть выбывшие заголовки. | |
| ' Установим флаг в false, чтобы не вывелась запись об отсутствии | |
| noLostNumbers = False | |
| While Not rsInventoriesWithLostUnits.EOF | |
| If Not IsEmpty(rsInventoriesWithLostUnits![INVENTORY_NUM_3].value) And rsInventoriesWithLostUnits![INVENTORY_NUM_3].value <> "" Then | |
| currNumIdentifier = CStr(rsInventoriesWithLostUnits![FUND_NUM_2]) & "." & _ | |
| CStr(rsInventoriesWithLostUnits![INVENTORY_NUM_1]) & "." & _ | |
| CStr(rsInventoriesWithLostUnits![INVENTORY_NUM_3]) | |
| Else | |
| currNumIdentifier = CStr(rsInventoriesWithLostUnits![FUND_NUM_2]) & "." & _ | |
| CStr(rsInventoriesWithLostUnits![INVENTORY_NUM_1]) | |
| End If | |
| ' Если текущий и предыдущий идентификаторы не совпадают, | |
| ' выведем вычисленный список выбывших заголовков в текущей описи | |
| If currNumIdentifier <> prevNumIdentifier Then | |
| ' выводим список, только если он есть | |
| ' и сразу очищаем | |
| Selection.TypeText Text:=unitsList | |
| unitsList = "" | |
| ' записать новый номер описи, предварительно убрав две запятые в конце списка заголовков | |
| Selection.TypeBackspace | |
| Selection.TypeBackspace | |
| Selection.TypeParagraph | |
| Selection.TypeParagraph | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:="ф. " & rsInventoriesWithLostUnits![FUND_NUM_2] | |
| Selection.TypeText Text:=" оп. " & rsInventoriesWithLostUnits![INVENTORY_NUM_1] | |
| If Not IsEmpty(rsInventoriesWithLostUnits![INVENTORY_NUM_3].value) And rsInventoriesWithLostUnits![INVENTORY_NUM_3].value <> "" And rsInventoriesWithLostUnits![INVENTORY_NUM_3].value <> 0 Then | |
| Selection.TypeText Text:=" т. " & rsInventoriesWithLostUnits![INVENTORY_NUM_3].value | |
| End If | |
| Selection.TypeText Text:=": " | |
| Selection.Font.Bold = False | |
| ' сменить идентификатор на текущий | |
| prevNumIdentifier = currNumIdentifier | |
| End If | |
| unitsList = unitsList & rsInventoriesWithLostUnits![UNIT_NUM_1] & rsInventoriesWithLostUnits![UNIT_NUM_2] & ", " | |
| rsInventoriesWithLostUnits.MoveNext | |
| Wend | |
| ' Вывести последний список выбывших заголовков | |
| Selection.TypeText Text:=unitsList | |
| Selection.TypeBackspace | |
| Selection.TypeBackspace | |
| End If | |
| If noLostNumbers Then | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=" отсутствуют" | |
| Selection.Font.Bold = False | |
| End If | |
| ' Закрыть рекордсет | |
| rsInventoriesWithLostUnits.Close | |
| End Sub | |
| Private Sub ShowInventoruesWithVolumes() | |
| ' Список описей с томами | |
| Dim rsInventoriesWithVolumes As ADODB.Recordset | |
| ' Флаг, указывающий на отсутствие описей с томами | |
| Dim noVolumes As Boolean | |
| ' Получить список описей с томами | |
| Set rsInventoriesWithVolumes = conn.Execute( _ | |
| "SELECT" & _ | |
| " cast (tblFUND.FUND_NUM_2 as int) AS FUND_NUM_2," & _ | |
| " cast (tblINVENTORY.INVENTORY_NUM_1 as int) AS INVENTORY_NUM_1," & _ | |
| " tblINVENTORY.INVENTORY_NUM_3 " & _ | |
| "FROM tblUNIT, tblINVENTORY, tblFUND " & _ | |
| "WHERE" & _ | |
| " (tblINVENTORY.INVENTORY_NUM_3 IS NOT NULL AND tblINVENTORY.INVENTORY_NUM_3 <> '' AND tblINVENTORY.INVENTORY_NUM_3 <> '0')" & _ | |
| " AND tblUNIT.Deleted <> 1" & _ | |
| " AND tblUNIT.NOTE LIKE '%параграф%'" & _ | |
| " AND tblUNIT.ISN_INVENTORY = tblINVENTORY.ISN_INVENTORY" & _ | |
| " AND tblINVENTORY.ISN_FUND = tblFUND.ISN_FUND " & _ | |
| "GROUP BY" & _ | |
| " FUND_NUM_2, INVENTORY_NUM_1, INVENTORY_NUM_3 " & _ | |
| "ORDER BY" & _ | |
| " FUND_NUM_2 ASC," & _ | |
| " INVENTORY_NUM_1 ASC," & _ | |
| " INVENTORY_NUM_3 ASC;") | |
| Selection.TypeParagraph | |
| Selection.TypeParagraph | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineSingle | |
| Selection.TypeText Text:="Описи с томами: " | |
| Selection.Font.UnderlineColor = wdColorAutomatic | |
| Selection.Font.Underline = wdUnderlineNone | |
| ' Изначально считаем, что описей с томами нет | |
| noVolumes = True | |
| If Not rsInventoriesWithVolumes.EOF Then | |
| rsInventoriesWithVolumes.MoveFirst | |
| ' Если есть результат запроса, значит есть описи с томами. | |
| ' Установим флаг в false, чтобы не вывелась запись об отсутствии | |
| noVolumes = False | |
| While Not rsInventoriesWithVolumes.EOF | |
| Selection.TypeBackspace | |
| Selection.TypeParagraph | |
| Selection.TypeParagraph | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:="ф. " & rsInventoriesWithVolumes![FUND_NUM_2] | |
| Selection.TypeText Text:=" оп. " & rsInventoriesWithVolumes![INVENTORY_NUM_1] | |
| If Not IsEmpty(rsInventoriesWithVolumes![INVENTORY_NUM_3].value) And rsInventoriesWithVolumes![INVENTORY_NUM_3].value <> "" And rsInventoriesWithVolumes![INVENTORY_NUM_3].value <> 0 Then | |
| Selection.TypeText Text:=" т. " & rsInventoriesWithVolumes![INVENTORY_NUM_3].value | |
| End If | |
| Selection.TypeText Text:=", " | |
| Selection.Font.Bold = False | |
| rsInventoriesWithVolumes.MoveNext | |
| Wend | |
| Selection.TypeBackspace | |
| Selection.TypeBackspace | |
| End If | |
| If noVolumes Then | |
| Selection.Font.Bold = True | |
| Selection.TypeText Text:=" отсутствуют" | |
| Selection.Font.Bold = False | |
| End If | |
| ' Закрыть рекордсет | |
| rsInventoriesWithVolumes.Close | |
| End Sub | |
| Private Sub Document_Open() | |
| Dim answer | |
| ConnectSqlServer | |
| answer = MsgBox("Могу я автоматически выполнить расчет? Понадобится некоторое время. Если вы просто хотите посмотреть страый отчет, можете нажать 'Нет'", vbYesNo) | |
| If answer = vbYes Then | |
| PrepareDocument | |
| LoadingText | |
| ShowTotalRecords | |
| ShowRecordsInInventoriesAndFunds | |
| ShowFilledFunds | |
| ShowFilledInventories | |
| ShowInventoriesWithoutPdf | |
| ShowInventoriesWithMissingNumbers | |
| ShowInventoriesWithLetterUnits | |
| ShowInventoriesWithLostUnits | |
| ShowInventoruesWithVolumes | |
| FinishText | |
| End If | |
| End Sub | |
| Private Sub Document_Close() | |
| ' Закрываем соединения | |
| If CBool(conn.State And adStateOpen) Then conn.Close | |
| Set conn = Nothing | |
| Set rs = Nothing | |
| End Sub | |
| Sub qt() | |
| Set rs = conn.Execute("SELECT COUNT(*) as count FROM [ArchiveFund5].[dbo].[tblUNIT] WHERE NOTE LIKE '%параграф%' and Deleted <> 1;") | |
| ' Проверить, что есть данные | |
| If Not rs.EOF Then | |
| rs.MoveFirst | |
| If rs![Count].value <> "" Then | |
| MsgBox rs![Count].value | |
| End If | |
| rs.MoveNext | |
| End If | |
| ' Закрыть рекордсет | |
| rs.Close | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment