Option Explicit
'Dim swDraw1 As Object
'Dim swModExt As Object
'Dim swBomTable As Object
'Dim swTable As Object
'Dim swTable1 As Object
'Dim swAnn As Object
'Dim swTextFormat As Object
'Dim swTextFormatUnd As Object
'Dim swTextFormatTest As Object
'Dim swBomFeat As Object
'Dim swSelMgr As Object
'Dim swNote As Object
'Dim swConfig As Object
Dim swDraw1 As SldWorks.DrawingDoc
Dim swModExt As SldWorks.ModelDocExtension
Dim swBomTable As SldWorks.BomTableAnnotation
Dim swTable As SldWorks.TableAnnotation
Dim swTable1 As SldWorks.TableAnnotation
Dim swAnn As SldWorks.Annotation
Dim swTextFormat As SldWorks.TextFormat
Dim swTextFormatUnd As SldWorks.TextFormat
Dim swTextFormatTest As SldWorks.TextFormat
Dim swBomFeat As SldWorks.BomFeature
Dim swSelMgr As SldWorks.SelectionMgr
Dim swNote As SldWorks.Note
Dim swConfig As SldWorks.Configuration
Dim swFeat As SldWorks.Feature
Dim fs As Object
Dim nNumRow As Long ' Число строк
Dim nNumRowTemp As Long ' Число строк для временного использования
Dim nNumColumn As Long ' Число колонок
Dim sSource As String
Dim sSource1 As String
Dim sSource2 As String
Dim sSource3 As String
Dim sSource6 As String
Dim sSource7 As String
Dim sSource11 As String
Dim sSource12 As String
Dim sSource13 As String
Dim sSource15 As String
Dim sSource16 As String
Dim sSource17 As String
Dim sSource18 As String
Dim sSource19 As String
Dim sConfigName As String
Dim vConfNameArr As Variant
Dim vConfVisible As Variant
Dim vConfVisibleSP As Variant
Dim vVisible As Variant
Dim vModelViewNames As Variant
Dim vRetval As Variant
Dim dRetval As Double
Dim lRetval As Long
Dim bRetval As Boolean
Dim ok As Boolean
Dim nConfNumb As Long
Dim sModelName As String
Dim sNumber As String ' ini
Dim sNumberText As String
'Dim mNumber As Integer ' Метка: 0 - св-во пользователя
Dim sDescription As String ' ini
Dim sDescriptionText As String
'Dim mDescription As Integer ' Метка: 0 - св-во пользователя
'Dim sFontName As String ' ini
'Dim dFontSize As Double ' ini
'Dim dFontSpace As Double ' ini
Dim dFontWidth As Double ' ini
Dim dRowWidth As Double ' ini
Dim dRemarkWidth As Double ' ini
Dim iSP1 As Integer ' ini
Dim iSP2 As Integer ' ini
Dim iGSP1 As Integer ' ini
Dim iGSP2 As Integer ' ini
Dim iVP1 As Integer ' ini
Dim iVP2 As Integer ' ini
Dim iLine As Integer ' ini
Dim iLineCount As Integer ' ini
Dim iSection As Integer ' ini
Dim iSectionCount As Integer ' ini
Dim iPosLine As Integer ' ini
Dim iPosLineCount As Integer ' ini
Dim iPosReserve As Integer ' ini
Dim iPosSection As Integer ' ini
Dim iPosSectionCount As Integer ' ini
Dim iForm0 As Integer ' ini
Dim iForm1 As Integer ' ini
Dim iForm2 As Integer ' ini
Dim iLRI As Integer ' ini
Dim iSort As Integer ' ini
Dim iOther As Integer ' ini
Dim sTemp() As String
Dim bTemp() As Boolean
Dim iTemp As Integer
Dim iTempArr() As Integer
Dim vSheetProps As Variant
Dim sSpecData() As String
Dim sSpecDataSize As Integer
Dim ComplectData() As String
Dim ComplectDataSize As Integer
Dim sSectionData() As String
Dim sGroupData() As String
Dim sMaterialGroupData() As String
Dim strTemp As String
Dim strTemp1 As String
Dim strTemp2 As String
Dim strTemp3 As String
Dim strTemp4 As String
Dim strTemp5 As String
Dim strTempData1() As String
Dim varTemp As Variant
Dim varTemp1 As Variant
Dim dblTemp As Double
Dim dblTemp1 As Double
Dim Result As String
Dim iSheetNumb As Integer
Dim DeleteOption As Long
Dim MForm As Integer  ' Метка флажка Задать формат: 0 - пользователь изменил флажок; 1 - флажок изменен из программы
Dim MSort As Integer  ' Метка кнопки сортировка
Dim MType As Integer ' Метка списка CboType: 0 - пользователь изменил список; 1 - список изменен из программы
Dim MTests As Integer ' Метка процедуры Tests: 0 - первичный вызов; 1 - вызов из ChkFormat_Click
Dim MCmdProp As Integer ' Метка кнопки Внести свойства
Dim MFormat As Integer  ' Метка кнопки Форматировать: 0 - пользователь нажал кнопку; 1 - вызвано из программы
Dim MPosition As Integer  ' Метка кнопки Расставить позиции: 0 - пользователь нажал кнопку; 1 - вызвано из программы
Dim sSheetsNames1 As String ' Имена листов со старыми версиями
Dim sSheetsNames2 As String ' Имена листов с нечитаемыми форматами
Dim sSheetsNames3 As String ' Имена листов с проблемами оформления
Dim strMsg As String ' Строка сообщения пользователю
Dim sFormatArray() As String
Dim strSheetFormatName As String
Dim intDRWSheet As Integer
Dim DocDataReal() As String ' Массив документов раздела Документация с учетом выбранных пользователем
Dim DocDataRealSize As Integer
Dim sRevision2 As String
Dim sRevision3 As String
Dim sRevision4 As String
Dim sDate As String
Dim nFirst As Integer ' Число строк первого листа
Dim nSecond As Integer ' Число строк второго листа
Dim m As Integer ' Метка
Dim m1 As Integer ' Метка
Dim m2 As Integer
Dim m3 As Integer
Dim ConfigTest As Integer ' Метка проверки числа конфигураций
Dim iResult As Integer
Dim n As Integer ' Носитель
Dim k As Integer ' Носитель
Dim k1 As Integer ' Носитель
Dim k2 As Integer
Dim k3 As Integer
Dim i As Integer ' Счетчик
Dim ii As Integer ' Счетчик
Dim j As Integer ' Счетчик
Dim j1 As Integer ' Счетчик
Dim jj As Integer
Dim jjj As Integer
Dim l As Integer
Dim l1 As Integer
Dim MyDateTime As Date
Dim nIndex                  As Long
Dim nCount                  As Long
Dim nStart                  As Long
Dim nEnd                    As Long
Dim nSplitDir               As Long
' *** MyProperties
    Dim prpNumber As String
    Dim prpDocCode As String
    Dim prpDocDescription As String
    Dim prpDescription As String
    Dim prpDescriptionMulti As String
    Dim prpCode As String
    Dim prpFormat As String
    Dim prpRemark As String
    Dim prpLit As String
    Dim prpLitTable As String
    Dim prpFirm As String
    Dim prpSection As String
    Dim prpGroup As String
    '
    Dim prpDesigner As String
    Dim prpTester As String
    Dim prpTechcontrol As String
    Dim prpWorkType As String
    Dim prpPerson As String
    Dim prpNormcontrol As String
    Dim prpApprove As String
    '
    Dim prpMass As String
    Dim prpMassTable As String
    Dim prpMaterial As String
    Dim prpMaterialTable As String
    '
    Dim prpFirstApply As String
    Dim prpInformNumber As String
    '
    Dim prpFirstApplySP As String
    Dim prpInformNumberSP As String
    Dim prpLitSP As String
    '
    Dim prpInformNumberVP As String
    Dim prpDescriptionVP As String
    Dim prpProductCodeVP As String
    Dim prpNumberDocVP As String
    Dim prpVendorVP As String
    Dim prpRemarkVP As String
    '
    Dim prpProject As String
    Dim prpDraftNumber As String
    Dim prpDraftDescription As String
    Dim prpDraftFirstApply As String
    Dim prpDraftFirstApplySP As String
    '
    Dim prpBlank As String
    '
    Dim prpBor As String
    '
    Dim prpQuantity As String
    '
    Dim prpTestVersion As Integer
    Dim prpTestFormat As Integer
    Dim prpTestName As Integer
'    Dim prpTestStandard As Integer
    '
    Dim prpFileName As Integer
    Dim prpNameSep As String
    Dim prpFontSize As Integer
    '
    Dim prpAddPRP1 As String
    Dim prpAddPRP2 As String
    '
    'Dim prpLeftTopCorner As Integer
    'Dim prpTopAll As Integer

Private Sub ChkAssem_Click()
MType = 1
CboType_Change
MType = 0
End Sub

Private Sub CboType_Change()

If CboType.ListIndex = 0 Then ' Спецификация
    FrmSpecEditor.Width = 463
    CmdDoc.Enabled = True
    Frame6.Enabled = True
    ChkAssem.Visible = True
ElseIf CboType.ListIndex = 1 Then ' Групповая спецификация
    FrmSpecEditor.Width = 567
    CmdDoc.Enabled = True
    Frame6.Enabled = True
    ChkAssem.Visible = False
Else ' Ведомость покупных
    FrmSpecEditor.Width = 463
    CmdDoc.Enabled = False
    Frame6.Enabled = False
    ChkAssem.Visible = False
End If
If mSpecType = CboType.ListIndex And mSpec = 1 And ChkAssem.Value = mChkAssem Then
    CmdSort.Enabled = True
    FrmLine.Enabled = True
    If ChkAssem.Value = True Then
        FrmSheet.Enabled = False
    Else
        FrmSheet.Enabled = True
    End If
    CmdFormat.Enabled = True
    CmdAddFormat.Enabled = True
    If CboType.ListIndex = 2 Then ' Ведомость покупных
        CmdPosition.Enabled = False
    Else
        CmdPosition.Enabled = True
    End If
Else
    CmdSort.Enabled = False
    FrmLine.Enabled = False
    FrmSheet.Enabled = False
    CmdFormat.Enabled = False
    CmdAddFormat.Enabled = False
    CmdPosition.Enabled = False
End If
' Задаем количество строк на листах
If CboType.ListIndex = 0 Then ' Спецификация
    nFirst = iSP1
    nSecond = iSP2
ElseIf CboType.ListIndex = 1 Then ' Групповая спецификация
    nFirst = iGSP1
    nSecond = iGSP2
Else ' Ведомость покупных
    nFirst = iVP1
    nSecond = iVP2
End If
If prpTestFormat = 1 And MType = 0 Then
    ChkFormat_Click
End If
End Sub

Private Sub CmdAddFormat_Click()
lRetval = swApp.SendMsgToUser2("Внимание! Данное действие приведет к перезаписи ячеек таблицы и потере связей со свойствами моделей." & Chr$(10) & _
"Чтобы исключить изменение свойств, проверьте, что установлен режим перезаписи ячеек." & Chr$(10) & _
"Повторная сортировка таблицы будет ошибочной. Все еще хотите продолжить?", swMbWarning, swMbYesNo)
If lRetval = swMbHitNo Then
    Exit Sub
End If
ImgInfo.Width = 5
nNumRow = swTable.RowCount
If iForm1 = 1 Then ' Выбрано убирать базовую часть обозначения для исполнений
    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then ' Спецификация или Групповая спецификация
    LblInfo.Caption = " Удаление базовой части обозначения"
    'If CboType.ListIndex = 1 Then  ' Групповая спецификация
        j = 0 ' Счетчик строк с исполнениями
        k = 0 ' Счетчик пустых строк
        For i = 1 To nNumRow - 1
            If i <> 1 Then ' Проверяем обозначения для исполнений
                If swTable.Text(i, 3) <> "" Then
                    Debug.Print swTable.Text(i, 3), "i=", i
                    strTemp = Right$(swTable.Text(i, 3), 4)
                    varTemp = InStrRev(strTemp, "-")
                    If varTemp > 0 Then ' Есть исполнение
                        varTemp = InStrRev(swTable.Text(i, 3), "-")
                        If Left$(swTable.Text(i, 3), 1) <> "-" Then ' Обозначение не укорочено, Сравниваем с базовой частью обозначения
                            Debug.Print Left$(swTable.Text(i, 3), varTemp - 1), Left$(swTable.Text(i - j - k - 1, 3), varTemp - 1)
                            If Left$(swTable.Text(i, 3), varTemp - 1) = Left$(swTable.Text(i - j - k - 1, 3), varTemp - 1) Then ' Совпадают
                                j = j + 1
                                strTemp = ""
                                For ii = 1 To (varTemp - 1) * 2
                                    strTemp = strTemp & " "
                                Next ii
                                Debug.Print "*" & strTemp & "*"
                                Debug.Print swTable.Text(i, 3)
                                strTemp = strTemp & Right$(swTable.Text(i, 3), Len(swTable.Text(i, 3)) - varTemp + 1)
                                swTable.Text(i, 3) = strTemp
                                swTable.Text(i, 0) = " "
                                If iForm0 = 1 Then ' Помечаем цветом
                                    ' Устанавливаем цвет
                                End If
                            Else
                                j = 0
                            End If
                        End If
                    Else
                        j = 0
                    End If
                    k = 0
                Else
                    k = k + 1
                    If j <> 0 Then
                        j = j + 1
                    End If
                End If
            End If
        Next i
    End If
End If
ImgInfo.Width = 220
If iForm2 = 1 Then ' Группировать стандартные
    Prepare ' Подготовка таблицы
    DeleteSpaceRow ' Удаление пустых строк
    LblInfo.Caption = " Группировка стандартных"
    i = 1
    jj = 1 ' Счетчик нужных строк
    j = 0 ' Номер первой строки одного ГОСТа
    n = 0 ' Метка конца одинаковых строк
    k = 1 ' Метка конца таблицы
    k1 = 1 ' Метка конца отбора первой строки
    k2 = 1 ' Метка конца отбора второй строки
    While k = 1
        Do While k1 = 1 ' Определяем первую строку
            If swTable.Text(i, 2) <> " " And swTable.Text(i, 2) <> "-" And swTable.Text(i, 3) = "" And swTable.Text(i, 4) <> "" Then ' Отсееваем лишние строки
                strTemp = swTable.Text(i, 4)
                Debug.Print strTemp, "jj=", jj
                ReDim Preserve iTempArr(jj)
                iTempArr(jj) = i
                jj = jj + 1
                Exit Do
            Else
                i = i + 1
            End If
            nNumRow = swTable.RowCount
            If i >= nNumRow - 2 Then
                k1 = 0
                Exit Do
            End If
        Loop
        If k1 <> 0 Then
            Do While k2 = 1 ' Определяем вторую строку
                If swTable.Text(i + 1, 2) <> " " And swTable.Text(i + 1, 2) <> "-" And swTable.Text(i + 1, 3) = "" And swTable.Text(i + 1, 4) <> "" Then ' Отсееваем лишние строки
                    strTemp1 = swTable.Text(i + 1, 4)
                    Exit Do
                Else
                    i = i + 1
                End If
                nNumRow = swTable.RowCount
                If i >= nNumRow - 2 Then
                    k2 = 0
                    Exit Do
                End If
            Loop
        End If
        If k1 <> 0 And k2 <> 0 Then
            ' Заменяем переносы на пробелы
            strTemp = Replace(strTemp, Chr$(13) & Chr$(10), " ")
            strTemp = Replace(strTemp, Chr$(10), " ")
            strTemp1 = Replace(strTemp1, Chr$(13) & Chr$(10), " ")
            strTemp1 = Replace(strTemp1, Chr$(10), " ")
            varTemp = InStrRev(strTemp, " ") ' Находим первый пробел с конца
            If varTemp > 0 Then
                varTemp1 = InStrRev(strTemp, " ", varTemp - 1) ' Находим второй пробел с конца
                If varTemp1 > 0 Then
                    Debug.Print Trim(Mid$(strTemp, varTemp1 + 1, varTemp - varTemp1 - 1))
                    If Trim(Mid$(strTemp, varTemp1 + 1, varTemp - varTemp1 - 1)) = "Р" Then
                        varTemp1 = InStrRev(strTemp, " ", varTemp1 - 1) ' Находим третий пробел с конца
                    End If
                    If varTemp1 > 0 Then
                        If Len(strTemp) > Len(strTemp) - varTemp1 And Len(strTemp1) > Len(strTemp) - varTemp1 Then ' Сравниваем стандарты
                            Debug.Print "Строки", strTemp, strTemp1
                            Debug.Print "1", "*" & Right$(strTemp, Len(strTemp) - varTemp1) & "*"
                            Debug.Print "2", "*" & Right$(strTemp1, Len(strTemp) - varTemp1) & "*"
                            Debug.Print "**************"
                            If Right$(strTemp, Len(strTemp) - varTemp1) = Right$(strTemp1, Len(strTemp) - varTemp1) Then ' Госты равны
                                If j = 0 Then
                                    strTemp2 = Right$(strTemp, Len(strTemp) - varTemp1) ' ГОСТ
                                    varTemp = InStr(strTemp, " ")
                                    strTemp3 = Left$(strTemp, varTemp - 1) ' Тип
                                    Select Case strTemp3
                                    Case "Болт"
                                        strTemp4 = "Болты " & strTemp2
                                    Case "Винт"
                                        strTemp4 = "Винты " & strTemp2
                                    Case "Гайка"
                                        strTemp4 = "Гайки " & strTemp2
                                    Case "Шайба"
                                        strTemp4 = "Шайбы " & strTemp2
                                    Case "Шпонка"
                                        strTemp4 = "Шпонки " & strTemp2
                                    Case "Штифт"
                                        strTemp4 = "Штифты " & strTemp2
                                    Case "Кольцо"
                                        strTemp4 = "Кольца " & strTemp2
                                    Case "Подшипник"
                                        strTemp4 = "Подшипники " & strTemp2
                                    Case "Шарик"
                                        strTemp4 = "Шарики " & strTemp2
                                    Case "Шпилька"
                                        strTemp4 = "Шпильки " & strTemp2
                                    Case "Шуруп"
                                        strTemp4 = "Шурупы " & strTemp2
                                    Case Else
                                        strTemp4 = strTemp3 & " " & strTemp2
                                    End Select
                                    j = jj - 1 ' Запоминаем первую строчку
                                End If
                                n = 1
                            End If
                        End If
                    End If
                End If
            End If
        End If
        nNumRow = swTable.RowCount
        If i >= nNumRow - 1 Then
            n = 0
            i = i + 1
        End If
        If j <> 0 And n = 0 Then ' Строчки с одним ГОСТом кончились
            For ii = j To jj - 1
                strTemp = swTable.Text(iTempArr(ii), 4)
                strTemp = Replace(strTemp, Chr$(13) & Chr$(10), " ")
                strTemp = Replace(strTemp, Chr$(10), " ")
                strTemp = RTrim(Left$(strTemp, Len(strTemp) - Len(strTemp2))) ' Отрезаем ГОСТ
                If strTemp3 <> "Шайба" Then ' Отрезаем Тип
                    strTemp = LTrim(Right$(strTemp, Len(strTemp) - Len(strTemp3)))
                End If
                swTable.Text(iTempArr(ii), 4) = strTemp
                If iForm0 = 1 Then ' Помечаем цветом
                    ' Устанавливаем цвет
                End If
            Next ii
            ok = swTable.InsertRow(swTableItemInsertPosition_Before, iTempArr(j))
            swTable.Text(iTempArr(j), 2) = " "
            swTable.Text(iTempArr(j), 4) = strTemp4
            i = i + 1
            j = 0
        End If
        n = 0
        i = i + 1
        nNumRow = swTable.RowCount
        If i > nNumRow - 1 Then
            k = 0
        End If
        Debug.Print "i=", i
    Wend
    SpaceRow ' Пустые строки
    MFormat = 1
        CmdFormat_Click ' Форматирование
    MFormat = 0
End If
ImgInfo.Width = 447
LblInfo.Caption = " Готово"
Finish
End Sub

Private Sub CmdDoc_Click() ' Документация
    mDocShow = 0
    FrmSpecEditor_Doc.Show ' vbModeless
    mDocShow = 1
    FrmSpecEditor_Doc.Show ' vbModeless
End Sub

Private Sub CmdLineUp_Click()
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstColumn As Long
Dim LastColumn As Long
Dim swSelData As SelectData
Dim swSelMgr As SelectionMgr
Set swSelMgr = swDraw.SelectionManager
Set swSelData = swSelMgr.CreateSelectData
swSelData.GetCellRange FirstRow, LastRow, FirstColumn, LastColumn
Debug.Print FirstRow, LastRow, FirstColumn, LastColumn
swTable.GetCellRange FirstRow, LastRow, FirstColumn, LastColumn
Debug.Print FirstRow, LastRow, FirstColumn, LastColumn
'swTable.SetCellRange 3, 4, 2, 3
End Sub

Private Sub CmdPosTest_Click()

Dim sTempArr1() As String
Dim sTempArr2() As String

ImgInfo.Width = 5

' Узнаем имя активного листа
Set swSheet = swDraw.GetCurrentSheet
strActiveSheetName = swSheet.GetName

' Определяем количество позиций в таблице
nNumRow = swTable.RowCount
jj = 0
ReDim sTempArr1(0)
For i = 1 To nNumRow - 1
If swTable.Text(i, 2) <> " " And swTable.Text(i, 2) <> "-" Then
    ReDim Preserve sTempArr1(jj)
    sTempArr1(jj) = swTable.Text(i, 2)
    jj = jj + 1
End If
Next i

' Считываем позиции с листов чертежа
vSheetNames = swDraw.GetSheetNames
j = 0
jj = 0
ReDim sTempArr2(0)
'Debug.Print "UBound(vSheetNames)", UBound(vSheetNames)
For i = 0 To UBound(vSheetNames)
    ' Проверка имени листа
    If Left$(vSheetNames(i), 3) = "DRW" Or Left$(vSheetNames(i), 4) = "Лист" Or Left$(vSheetNames(i), 5) = "Sheet" Then
        j = j + 1
        ok = swDraw.ActivateSheet(vSheetNames(i))
        Set swSheet = swDraw.GetCurrentSheet
        'strTemp = "DRW" & CStr(j)
        'vSheetProps = swSheet.GetProperties
        'ok = swDraw.SetupSheet4(strTemp, vSheetProps(0), vSheetProps(1), Numerator, Denominator, vSheetProps(4), swSheet.GetTemplateName, vSheetProps(5), vSheetProps(6), swSheet.CustomPropertyView)
        Set swView = swDraw.GetFirstView
        Do While Not swView Is Nothing
            Set swNote = swView.GetFirstNote
            Do While Not swNote Is Nothing
                If swNote.IsBomBalloon Then
                    If swNote.GetBomBalloonTextStyle(True) = swDetailingNoteTextItemNumber Then
                        Debug.Print swNote.GetText
                        ReDim Preserve sTempArr2(jj)
                        sTempArr2(jj) = swNote.GetText
                        jj = jj + 1
                    End If
                End If
                Set swNote = swNote.GetNext
            Loop
            Set swView = swView.GetNextView
        Loop
    End If
Next i

' Проверка повторяющихся позиций
strTemp = ""
For i = 0 To UBound(sTempArr2) - 1
    For j = i + 1 To UBound(sTempArr2)
        If sTempArr2(i) = sTempArr2(j) Then
            If strTemp = "" Then
                strTemp = sTempArr2(j)
            Else
                strTemp = strTemp & ", " & sTempArr2(j)
            End If
        End If
    Next j
Next i

' Проверка пропущенных позиций
strTemp1 = ""
For i = 0 To UBound(sTempArr1)
    m = 0
    For ii = 0 To i - 1
        If sTempArr1(i) = sTempArr1(ii) Then
            m = 1
            Exit For
        End If
    Next ii
    If m = 0 Then
        For j = 0 To UBound(sTempArr2)
            If sTempArr1(i) = sTempArr2(j) Then
                m = 1
                Exit For
            End If
        Next j
        If m = 0 Then
            If strTemp1 = "" Then
                strTemp1 = sTempArr1(i)
            Else
                strTemp1 = strTemp1 & ", " & sTempArr1(i)
            End If
        End If
    End If
Next i
If strTemp = "" And strTemp1 = "" Then
    lRetval = swApp.SendMsgToUser2("Позиции проставлены правильно.", swMbWarning, swMbOk)
ElseIf strTemp = "" And strTemp1 <> "" Then
    strMsg = "Пропущены следующие позиции: " & strTemp1 & "."
    lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbOk)
ElseIf strTemp <> "" And strTemp1 = "" Then
    strMsg = "Имеются повторы позиций: " & strTemp & "."
    lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbOk)
Else
    strMsg = "Пропущены следующие позиции: " & strTemp1 & "." & Chr$(10) & _
    "Имеются повторы позиций: " & strTemp & "."
    lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbOk)
End If

' Возвращение активного листа
ok = swDraw.ActivateSheet(strActiveSheetName)

ImgInfo.Width = 447
LblInfo.Caption = " Готово"
Finish
End Sub

Private Sub CmdPref_Click() ' Настройки
    FrmSpecEditor_Pref.Show 'vbModeless
End Sub

Function BOMPartNumber(swConfigTemp As Object) As String ' Part Number (swConfigTemp As SldWorks.Configuration)
    Select Case swConfigTemp.BOMPartNoSource
    Case swBOMPartNumber_ConfigurationName
        BOMPartNumber = swConfigTemp.Name
    Case swBOMPartNumber_DocumentName
        BOMPartNumber = sModelName
    Case swBOMPartNumber_UserSpecified
        BOMPartNumber = swConfigTemp.AlternateName
    Case swBOMPartNumber_ParentName
        Dim swParentConfig As SldWorks.Configuration
        Set swParentConfig = swConfigTemp.GetParent
            BOMPartNumber = BOMPartNumber(swParentConfig)
    End Select
End Function

Private Sub CmdProp_Click()

If MCmdProp = 0 Then
    ImgInfo.Width = 5
End If
LblInfo.Caption = " Запись свойств"

' Заносим свойства в модель
If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    ' Первичное применение
    ok = swModel.AddCustomInfo3(sConfigName, prpFirstApplySP, swCustomInfoText, TxtFirst.Value)
    swModel.CustomInfo2(sConfigName, prpFirstApplySP) = TxtFirst.Value
    ' Эскизное Первичное применение
    ok = swModel.AddCustomInfo3(sConfigName, prpDraftFirstApplySP, swCustomInfoText, TxtDraftFirst.Value)
    swModel.CustomInfo2(sConfigName, prpDraftFirstApplySP) = TxtDraftFirst.Value
    ' Справочный номер
    ok = swModel.AddCustomInfo3(sConfigName, prpInformNumberSP, swCustomInfoText, TxtInform.Value)
    swModel.CustomInfo2(sConfigName, prpInformNumberSP) = TxtInform.Value
    If CboType.ListIndex = 1 Then  ' Групповая спецификация
        ok = swModel.AddCustomInfo3(sConfigName, prpLitSP, swCustomInfoText, "")
        If ChkLit.Value = True Then
            swModel.CustomInfo2(sConfigName, prpLitSP) = "-"
        Else
            swModel.CustomInfo2(sConfigName, prpLitSP) = swModel.CustomInfo2(sConfigName, prpLitTable)
        End If
    End If
    ' Код и Наименование документа
    If ChkAssem.Value = True Then
        swModel.CustomInfo2(sConfigName, prpDocCode) = ""
        swModel.CustomInfo2(sConfigName, prpDocDescription) = ""
    Else
        swModel.CustomInfo2(sConfigName, prpDocCode) = "СБ"
        If prpFontSize = 1 Then
            swModel.CustomInfo2(sConfigName, prpDocDescription) = "<FONT size=1> " & Chr$(10) & "<FONT size=2.5>" & "Сборочный чертеж"
        Else
            swModel.CustomInfo2(sConfigName, prpDocDescription) = "Сборочный чертеж"
        End If
    End If
Else ' Ведомость покупных
    ' Первичное применение
    ok = swModel.AddCustomInfo3(sConfigName, prpFirstApply, swCustomInfoText, TxtFirst.Value)
    swModel.CustomInfo2(sConfigName, prpFirstApply) = TxtFirst.Value
    ' Справочный номер
    ok = swModel.AddCustomInfo3(sConfigName, prpInformNumberVP, swCustomInfoText, TxtInform.Value)
    swModel.CustomInfo2(sConfigName, prpInformNumberVP) = TxtInform.Value
End If

' Заносим свойства в чертеж
ok = swDraw.AddCustomInfo2("CheckFormat", 30, "")
swDraw.CustomInfo2("", "CheckFormat") = ChkFormat.Value

If MCmdProp = 0 Then
    swDraw.ForceRebuild3 (True)
    ImgInfo.Width = 447
    LblInfo.Caption = " Готово"
    Finish
End If

End Sub

Private Sub Prepare() ' Подготовка таблицы

LblInfo.Caption = " Подготовка таблицы"

' Получаем инфу о разделении таблицы
nSplitDir = swTable.GetSplitInformation(nIndex, nCount, nStart, nEnd)
'Debug.Print nSplitDir
'Debug.Print nIndex
'Debug.Print nCount
'Debug.Print nStart
'Debug.Print nEnd

' Объединяем части таблицы
If nSplitDir <> swTableSplit_None Then
    For i = 1 To nCount - 1
        ok = swTable.Merge(swTableSplit_AfterRow)
    Next i
End If

' Скрываем таблицу
Set swAnn = swTable.GetAnnotation
swAnn.Visible = swAnnotationHidden

' Разбиваем ячейки
nNumRow = swTable.RowCount
If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    For i = 0 To nNumRow - 1
        ok = swTable.UnmergeCells(i, 3)
        ok = swTable.UnmergeCells(i, 4)
        ok = swTable.UnmergeCells(i, nNumColumn - 1)
    Next i
    ok = swTable.UnmergeCells(0, 5)
Else ' Ведомость покупных
    For i = 0 To nNumRow - 1
        ok = swTable.UnmergeCells(i, 1)
        ok = swTable.UnmergeCells(i, 2)
        ok = swTable.UnmergeCells(i, 3)
        ok = swTable.UnmergeCells(i, 4)
        ok = swTable.UnmergeCells(i, 5)
        ok = swTable.UnmergeCells(i, nNumColumn - 1)
    Next i
    ok = swTable.UnmergeCells(0, 6)
End If

End Sub

Private Sub DeleteSpaceRow()

LblInfo.Caption = " Удаление пустых строк"

' Удаляем пустые строки
nNumRow = swTable.RowCount
nNumColumn = swTable.ColumnCount
k = 1
n = 0
For i = 1 To nNumRow - 1 - n
    m = 0
    For j = 0 To nNumColumn - 1
        If swTable.Text(k, j) = "" Or swTable.Text(k, j) = " " Then
        Else
            m = 1
        End If
    Next j
    If m = 0 Then
        ok = swTable.DeleteRow(k)
        n = n + 1
    Else
        k = k + 1
    End If
Next i
End Sub

Private Sub CmdSort_Click() ' Сортировка

' Проверка выбранных конфигураций
If CboType.ListIndex = 1 Then ' Групповая спецификация
    LstConfigTest
    If ConfigTest = 0 Then
        swApp.SendMsgToUser ("Необходимо выбрать хотя бы одно исполнение.")
        Exit Sub
    End If
End If

ImgInfo.Width = 5

Prepare ' Подготовка таблицы
DeleteSpaceRow ' Удаление пустых строк
'For i = 0 To UBound(DocData)
'    Debug.Print "DocData", i, "=", DocData(i)
'Next i

' Добавляем/удаляем дополнительные пустые колонки для групповой спецификации
If CboType.ListIndex = 1 Then ' Групповая спецификация
    If nNumColumn > 16 Then
        For i = 0 To nNumColumn - 16 - 1
            ok = swTable.DeleteColumn(14)
        Next i
    ElseIf nNumColumn < 16 Then
        For i = 0 To 16 - nNumColumn - 1
            ok = swTable.InsertColumn(swTableItemInsertPosition_After, nNumColumn - 2, "")
            ok = swTable.SetColumnType(swTable.ColumnCount - 2, swWeldTableColumnType_CustomProperty)
        Next i
    End If
End If
LblInfo.Caption = " Чтение разделов"
If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    ' Проверяем раздел Документация
    nNumRow = swTable.RowCount
    nNumColumn = swTable.ColumnCount
    If sNumber = "1" Then ' Обозначение
        strTemp = sNumberText
        If sNumberText = sModelName Then
            strTemp = "$PRPSHEET:" & Chr$(34) & "SW-File Name" & Chr$(34)
        End If
    Else
        strTemp = "$PRPSHEET:" & Chr$(34) & prpNumber & Chr$(34)
    End If
    k = -1 ' Cчетчик строк DocDataReal
    k1 = -1 ' Счетчик строк, включенных в списке "Добавления"
    l = -1 ' Номер последней добавленной строки из DocData
    n = 0 ' Счетчик удаленных строк
    ReDim DocDataReal(1000, nNumColumn - 1) ' Массив документов раздела Документация с учетом выбранных пользователем
    For i = 0 To nNumRow - 2 - n
        strTemp3 = swTable.Text(1, 4) ' Строка из таблицы
        m = 0 ' Метка конца раздела Документация
        For j = 1 To UBound(sSectionData) ' Проверяем конец раздела Документация
            If strTemp3 = sSectionData(j) Then ' Раздел Документация закончился
                m = 1
            End If
        Next j
        If m = 1 Then
            Exit For
        End If
        If strTemp3 = "" Or strTemp3 = "Документация" Then  ' Пропускаем заголовок Документация
        Else ' Строка для анализа
            m = 0 ' Метка самопальной строки
            For j = 0 To UBound(strTempData) ' Проверяем список документов
                strTemp2 = strTempData(j)
                strTemp2 = Right$(strTemp2, Len(strTemp2) - InStr(strTemp2, "-"))
                strTemp2 = Trim(strTemp2)
                If strTemp3 = strTemp2 Then ' Строка есть в списке документов
                    m = 1
                    For jj = 0 To UBound(DocData) ' Проверяем включенные строки
                        strTemp1 = DocData(jj)
                        strTemp1 = Right$(strTemp1, Len(strTemp1) - InStr(strTemp1, "-"))
                        strTemp1 = Trim(strTemp1)
                        If strTemp3 = strTemp1 Then  ' Строка включена
                            If k <> -1 Then
                                If strTemp3 <> DocDataReal(k, 4) Then ' Проверка для одинаковых документов груп. спец.
                                    k1 = k1 + 1
                                End If
                            Else
                                k1 = k1 + 1
                            End If
                            k = k + 1
                            If k1 < jj Then ' Есть новые включенные строки
                                'Debug.Print "k1 < jj", "k1=", k1, "jj=", jj, "l=", l
                                For jjj = 0 To jj - k1 - 1
                                    strTemp1 = Left$(DocData(l + jjj + 1), InStr(DocData(l + jjj + 1), "-") - 1)
                                    strTemp1 = Trim(strTemp1)
                                    strTemp2 = Right$(DocData(l + jjj + 1), Len(DocData(l + jjj + 1)) - InStr(DocData(l + jjj + 1), "-"))
                                    strTemp2 = Trim(strTemp2)
                                    '!!!!!!!!!!!!!!' Формат
                                    DocDataReal(k, 2) = " " ' Позиция
                                    If Left$(strTemp1, 1) = "+" Then
                                        strTemp1 = Right$(strTemp1, Len(strTemp1) - 1)
                                        DocDataReal(k, 3) = strTemp1 ' Обозначение
                                    Else
                                        DocDataReal(k, 3) = strTemp & strTemp1 ' Обозначение
                                    End If
                                    DocDataReal(k, 4) = strTemp2 ' Наименование
                                    '!!!!!!!!!!!!!!' Примечание
                                    k = k + 1
                                    k1 = k1 + 1
                                Next jjj
                            End If
                            For jjj = 0 To nNumColumn - 1
                                DocDataReal(k, jjj) = swTable.Text(1, jjj)
                            Next jjj
                            l = jj
                            Exit For
                        End If
                    Next jj
                    Exit For
                End If
            Next j
            If m = 0 Then ' Строка самопальная
                If swTable.Text(1, 2) = " " Then ' Проверяем отображение позиции (для спецификаций, вставленных вручную)
                    k = k + 1
                    For jjj = 0 To nNumColumn - 1
                        DocDataReal(k, jjj) = swTable.Text(1, jjj)
                    Next jjj
                Else
                    Exit For
                End If
            End If
        End If
        ok = swTable.DeleteRow(1)
        n = n + 1
    Next i

    'Debug.Print "UBound(DocData)", UBound(DocData)
    'Debug.Print "k1", k1
    'Debug.Print "k", k

    If UBound(DocData) > k1 Then
        'Debug.Print "Добавление в конец", UBound(DocData) - k1, "строк"
        For jjj = 0 To UBound(DocData) - k1 - 1
            k = k + 1
            strTemp1 = Left$(DocData(l + jjj + 1), InStr(DocData(l + jjj + 1), "-") - 1)
            strTemp1 = Trim(strTemp1)
            strTemp2 = Right$(DocData(l + jjj + 1), Len(DocData(l + jjj + 1)) - InStr(DocData(l + jjj + 1), "-"))
            strTemp2 = Trim(strTemp2)
            '!!!!!!!!!!!!!!' Формат
            DocDataReal(k, 2) = " " ' Позиция
            If Left$(strTemp1, 1) = "+" Then
                strTemp1 = Right$(strTemp1, Len(strTemp1) - 1)
                DocDataReal(k, 3) = strTemp1 ' Обозначение
            Else
                DocDataReal(k, 3) = strTemp & strTemp1 ' Обозначение
            End If
            DocDataReal(k, 4) = strTemp2 ' Наименование
            '!!!!!!!!!!!!!!' Примечание
        Next jjj
    End If

    DocDataRealSize = k
    'For i = 0 To DocDataRealSize
        'Debug.Print "DocDataReal", i, "=", DocDataReal(i, 4)
    'Next i
End If
MSort = 1
CmdOk_Click
MSort = 0

End Sub

Public Sub UserForm_Activate()
HWNDActiveWindow
MSort = 0
MForm = 0
MType = 1
MCmdProp = 0
MFormat = 0
MPosition = 0
LblInfo.Caption = ""
If mRunPref = 0 Then ' Первичный запуск или после изменения настроек в окне Настройки

    sSource = swApp.GetCurrentMacroPathName             ' Get macro path+filename
    sSource1 = Left$(sSource, Len(sSource) - 4) & "_sp.sldbomtbt"    ' Шаблон спецификации
    sSource2 = Left$(sSource, Len(sSource) - 14) & "SP-1.slddrt"    ' Шаблон 1-го листа
    sSource3 = Left$(sSource, Len(sSource) - 14) & "SP-2.slddrt"    ' Шаблон 2-го листа
    sSource4 = Left$(sSource, Len(sSource) - 3) & "ini"    ' ini-файл
    sSource5 = Left$(sSource, Len(sSource) - 4) & "_Doc.txt"    ' Документация
    sSource6 = Left$(sSource, Len(sSource) - 14) & "GSP-1.slddrt"    ' Шаблон 1-го листа
    sSource7 = Left$(sSource, Len(sSource) - 14) & "GSP-2.slddrt"    ' Шаблон 2-го листа
    sSource8 = Left$(sSource, Len(sSource) - 4) & "_Sections.txt"    ' Разделы
    sSource9 = Left$(sSource, Len(sSource) - 4) & "_Groups.txt"    ' Группы разделов "Стандартные изделия" и "Прочие изделия"
    sSource10 = Left$(sSource, Len(sSource) - 4) & "_MaterialGroups.txt"    ' Группы раздела "Материалы"
    sSource11 = Left$(sSource, Len(sSource) - 4) & "_vp.sldbomtbt"    ' Шаблон ведомости покупных
    sSource12 = Left$(sSource, Len(sSource) - 14) & "VP-1.slddrt"    ' Шаблон 1-го листа
    sSource13 = Left$(sSource, Len(sSource) - 14) & "VP-2.slddrt"    ' Шаблон 2-го листа
    sSource14 = Left$(sSource, Len(sSource) - 14) + "MyProperties.swp" ' Путь к макросу MyProperties
    sSource15 = Left$(sSource, Len(sSource) - 14) & "MyProperties_1.ini" ' Путь к списку свойств
    sSource16 = Left$(sSource, Len(sSource) - 14) & "MyProperties_2.ini" ' Путь к настройкам оформления
    sSource17 = Left$(sSource, Len(sSource) - 14) & "MyStandard.sldstd" ' Путь к файлу стандарта
    sSource18 = Left$(sSource, Len(sSource) - 14) & "SP-LRI.slddrt"    ' Шаблон ЛРИ
    sSource19 = Left$(sSource, Len(sSource) - 14) & "VP-LRI.slddrt"    ' Шаблон ЛРИ

    '  Получаем параметры модели
    ok = swDraw.ActivateSheet(vSheetNames(0))
    Set swSheet = swDraw.GetCurrentSheet
    Set swView = swDraw.GetFirstView
    m = 0
    If swSheet.CustomPropertyView = "По умолчанию" Or swSheet.CustomPropertyView = "Default" Then
        Set swView = swView.GetNextView ' Получаем первый вид
    Else
        Do Until swView Is Nothing
            If swView.GetName2 = swSheet.CustomPropertyView Then
                m = 1
                Exit Do
            End If
            Set swView = swView.GetNextView
        Loop
        If m = 0 Then
            Set swView = swDraw.GetFirstView
            Set swView = swView.GetNextView
            swApp.SendMsgToUser ("Не удалось определить вид из свойств листа. Используется первый вид.")
        End If
    End If
    sConfigName = swView.ReferencedConfiguration ' Имя конфигурации вида
    'Debug.Print "sConfigName=", sConfigName
    Set swModel = swView.ReferencedDocument
    Set swConfig = swModel.GetConfigurationByName(sConfigName)
    'Debug.Print swConfig.AlternateName, swConfig.UseAlternateNameInBOM
    vConfNameArr = swModel.GetConfigurationNames ' Имена всех конфигураций если спецификация с исполнениями
    Set swSelMgr = swDraw.SelectionManager
    ' Получение имени модели
    sModelName = swModel.GetTitle
    vModelViewNames = swModel.GetModelViewNames
    ' Проверка на наличие расширения в имени файла
    If Len(sModelName) > 7 Then
        strTemp = Mid$(sModelName, Len(sModelName) - 6, 4)
        If strTemp = ".SLD" Or strTemp = ".sld" Then
            sModelName = Left$(sModelName, Len(sModelName) - 7)
        End If
    End If

    MyProperties
    If prpTestStandard = 1 Then
        MyStandard
    End If

    ' Чтение ini файла
    Open sSource4 For Input As #1
        If prpTestStandard = 1 Then
            Line Input #1, strTemp
            Line Input #1, strTemp
            Line Input #1, strTemp
            Line Input #1, strTemp
        Else
            Line Input #1, strTemp ' Шрифт
            stdFontName = strTemp
            Line Input #1, strTemp ' Размер шрифта
            strTemp = Replace(strTemp, ".", ",")
            stdFontSize = CDbl(strTemp)
            Line Input #1, strTemp ' Наклонный
            If strTemp = "1" Then
                stdFontItalic = 1
            Else
                stdFontItalic = 0
            End If
            Line Input #1, strTemp ' Жирный
            If strTemp = "1" Then
                stdFontBold = 1
            Else
                stdFontBold = 0
            End If
        End If
        Line Input #1, strTemp ' Сжатие общее
        dFontWidth = CDbl(strTemp)
        Line Input #1, strTemp ' Сжатие длинных строк
        dRowWidth = CDbl(strTemp)
        Line Input #1, strTemp ' Сжатие столбца Примечание
        dRemarkWidth = CDbl(strTemp)
        '
        Line Input #1, sNumber ' Обозначение
        Line Input #1, sDescription ' Наименование
        '
        Line Input #1, strTemp
        iSP1 = strTemp
        Line Input #1, strTemp
        iSP2 = strTemp
        Line Input #1, strTemp
        iGSP1 = strTemp
        Line Input #1, strTemp
        iGSP2 = strTemp
        Line Input #1, strTemp
        iVP1 = strTemp
        Line Input #1, strTemp
        iVP2 = strTemp
        '
        Line Input #1, strTemp ' После каждой строки
        If strTemp = "1" Then
            iLine = 1
        Else
            iLine = 0
        End If
        Line Input #1, strTemp
        iLineCount = CInt(strTemp)
        '
        Line Input #1, strTemp ' В конце раздела
        If strTemp = "1" Then
            iSection = 1
        Else
            iSection = 0
        End If
        Line Input #1, strTemp
        iSectionCount = CInt(strTemp)
        '
        Line Input #1, strTemp ' После каждой строки
        If strTemp = "1" Then
            iPosLine = 1
        Else
            iPosLine = 0
        End If
        Line Input #1, strTemp
        iPosLineCount = CInt(strTemp)
        '
        Line Input #1, strTemp ' В конце раздела
        If strTemp = "1" Then
            iPosSection = 1
        Else
            iPosSection = 0
        End If
        Line Input #1, strTemp
        iPosSectionCount = CInt(strTemp)
        '
        Line Input #1, strTemp ' По числу резервированных строк
        If strTemp = "1" Then
            iPosReserve = 1
        Else
            iPosReserve = 0
        End If
        '
        Line Input #1, strTemp ' Помечать цветом
        If strTemp = "1" Then
            iForm0 = 1
        Else
            iForm0 = 0
        End If
        Line Input #1, strTemp ' Убирать базовую часть обозначения для исполнений
        If strTemp = "1" Then
            iForm1 = 1
        Else
            iForm1 = 0
        End If
        Line Input #1, strTemp ' Группировать стандартные
        If strTemp = "1" Then
            iForm2 = 1
        Else
            iForm2 = 0
        End If
        Line Input #1, strTemp ' Добавлять ЛРИ
        If strTemp = "1" Then
            iLRI = 1
        Else
            iLRI = 0
        End If
        Line Input #1, strTemp ' Использовать быструю сортировку
        If strTemp = "1" Then
            iSort = 1
        Else
            iSort = 0
        End If
        Line Input #1, strTemp ' Сортировка Прочих как Стандартных
        If strTemp = "1" Then
            iOther = 1
        Else
            iOther = 0
        End If
    Close #1

    ' Заполнение списка CboType
    CboType.Clear
    CboType.AddItem "Спецификация"
    CboType.AddItem "Групповая спецификация (Вариант Б)"
    CboType.AddItem "Ведомость покупных изделий"
    CboType.ListIndex = 0
    CboType_Change

    ' Заполняем массив sSectionData
    n = -1
    Open sSource8 For Input As #1
    Do While Not EOF(1)
        Input #1, strTemp
        n = n + 1
        ReDim Preserve sSectionData(n)
        sSectionData(n) = strTemp
    Loop
    Close #1

    ' Заполняем массив sGroupData
    n = -1
    Open sSource9 For Input As #1
    Do While Not EOF(1)
        Input #1, strTemp
        n = n + 1
        ReDim Preserve sGroupData(n)
        sGroupData(n) = strTemp
    Loop
    Close #1

    ' Заполняем массив sMaterialGroupData
    n = -1
    Open sSource10 For Input As #1
    Do While Not EOF(1)
        Input #1, strTemp
        n = n + 1
        ReDim Preserve sMaterialGroupData(n)
        sMaterialGroupData(n) = strTemp
    Loop
    Close #1

    ' Обозначение
    If sNumber = "1" Then
        sNumberText = BOMPartNumber(swConfig)
    Else
        sNumberText = swModel.CustomInfo2(sConfigName, prpNumber)
        If sNumberText = "" Then
            sNumberText = swModel.CustomInfo2("", prpNumber)
        End If
    End If
    LblNumber.Caption = sNumberText
    ' Проверяем наличие ссылок
    strTemp = "$PRP:" & Chr$(34) & "SW-File Name" & Chr$(34)
    If InStr(sNumberText, strTemp) > 0 Then
        LblNumber.Caption = Replace(sNumberText, strTemp, sModelName)
    End If
    While InStr(LblNumber.Caption, "$PRP:") > 0
        n = InStr(LblNumber.Caption, "$PRP:") + 6 ' Начало имени свойства
        l = InStr(n, LblNumber.Caption, Chr$(34)) - n  ' Длина имени
        strTemp = Mid$(LblNumber.Caption, n, l) ' Имя свойства
        'Debug.Print "Свойство", strTemp, "n=", n, "l=", l
        strTemp1 = "$PRP:" & Chr$(34) & strTemp & Chr$(34)
        strTemp2 = swModel.CustomInfo2(sConfigName, strTemp)
        If strTemp2 = "" Then
            strTemp2 = swModel.CustomInfo2("", strTemp)
        End If
        LblNumber.Caption = Replace(LblNumber.Caption, strTemp1, strTemp2)
    Wend

    ' Наименование
    If sDescription = "1" Then
        sDescriptionText = BOMPartNumber(swConfig)
        LblDescription.Font.Size = 14
    Else
        sDescriptionText = swModel.CustomInfo2(sConfigName, prpDescription)
        If sDescriptionText = "" Then
            sDescriptionText = swModel.CustomInfo2("", prpDescription)
        End If
        strTemp = swModel.CustomInfo2("", prpDescriptionMulti)
        If InStrRev(strTemp, "<FONT size=3.5>") > 0 Then
            LblDescription.Font.Size = 11
        Else
            LblDescription.Font.Size = 14
        End If
    End If
    LblDescription.Caption = sDescriptionText
    ' Проверяем наличие ссылок
    strTemp = "$PRP:" & Chr$(34) & "SW-File Name" & Chr$(34)
    If InStr(sDescriptionText, strTemp) > 0 Then
        LblDescription.Caption = Replace(sDescriptionText, strTemp, sModelName)
    End If
    While InStr(LblDescription.Caption, "$PRP:") > 0
        n = InStr(LblDescription.Caption, "$PRP:") + 6 ' Начало имени свойства
        l = InStr(n, LblDescription.Caption, Chr$(34)) - n  ' Длина имени
        strTemp = Mid$(LblDescription.Caption, n, l) ' Имя свойства
        'Debug.Print "Свойство", strTemp
        strTemp1 = "$PRP:" & Chr$(34) & strTemp & Chr$(34)
        strTemp2 = swModel.CustomInfo2(sConfigName, strTemp)
        If strTemp2 = "" Then
            strTemp2 = swModel.CustomInfo2("", strTemp)
        End If
        LblDescription.Caption = Replace(LblDescription.Caption, strTemp1, strTemp2)
    Wend

    ' Конфигурация
    LblConfig.Caption = sConfigName
    Debug.Print "LblConfig.Caption=", LblConfig.Caption
    ' Сортируем список конфигураций
    For i = 0 To UBound(vConfNameArr) - 1
        For j = 0 To UBound(vConfNameArr) - 1 - i
            If vConfNameArr(j) > vConfNameArr(j + 1) Then
                strTemp = vConfNameArr(j + 1)
                vConfNameArr(j + 1) = vConfNameArr(j)
                vConfNameArr(j) = strTemp
            End If
        Next j
    Next i
    LstConfig.Clear
    For i = 0 To UBound(vConfNameArr)
        LstConfig.AddItem vConfNameArr(i)
        If vConfNameArr(i) = sConfigName Then
            LstConfig.Selected(i) = True
        End If
    Next i

    ' Считываем информацию о датах и изменениях с первого листа
    strSheetFormatName = swSheet.GetSheetFormatName()
    strTemp = "Revision2@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        sRevision2 = swNote.GetText()
    End If
    strTemp = "Revision3@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        sRevision3 = swNote.GetText()
    End If
    strTemp = "Revision4@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        sRevision4 = swNote.GetText()
    End If
    strTemp = "Date@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        sDate = swNote.GetText()
    End If

    ' Формат и Примечание
    ' Cвойство "Примечание"
    TxtRemark.Value = ""
    ' Заполнение списка Формат и проверка Формата
    CboFormat.Clear
    CboFormat.AddItem ""
    CboFormat.AddItem "А4"
    CboFormat.AddItem "А3"
    CboFormat.AddItem "А2"
    CboFormat.AddItem "А1"
    CboFormat.AddItem "А0"
    CboFormat.AddItem "БЧ"
    CboFormat.AddItem "*)"
    CboFormat.Value = ""
    If prpTestFormat = 1 Then ' Есть проверка
        MForm = 1 ' Метка флажка Задать формат: 0 - пользователь изменил флажок; 1 - флажок изменен из программы
        ChkFormat.Enabled = True
        If swDraw.CustomInfo2("", "CheckFormat") = "True" Or swDraw.CustomInfo2("", "CheckFormat") = "-1" Then
            ChkFormat.Value = True
        Else
            ChkFormat.Value = False
        End If
        MForm = 0
    Else ' Нет проверки
        MForm = 1
        ChkFormat.Enabled = False
        ChkFormat.Value = True
        CboFormat.Enabled = True
        TxtRemark.Enabled = True
        MForm = 0
    End If
    ' Читаем файл Doc.txt и заполняем им массив strTempData
    Open sSource5 For Input As #1
    n = 0
    ReDim strTempData(0)
    strTempData(0) = "СБ - Сборочный чертеж"
    Do While Not EOF(1)
        n = n + 1
        ReDim Preserve strTempData(n)
        Input #1, strTemp
        strTempData(n) = strTemp
    Loop
    Close #1
    ' Проверяем существование спецификации и определяем ее тип
    CmdSort.Enabled = False
    FrmLine.Enabled = False
    FrmSheet.Enabled = False
    CmdFormat.Enabled = False
    CmdAddFormat.Enabled = False
    CmdPosition.Enabled = False
    CmdPosTest.Enabled = False
    ' Проверяем первый лист
    ChkAssem.Value = False
    ok = swDraw.ActivateSheet(vSheetNames(0))
    Set swSheet = swDraw.GetCurrentSheet
    Set swView = swDraw.GetFirstView
    If Not swView Is Nothing Then
        Set swTable = swView.GetFirstTableAnnotation
        If Not swTable Is Nothing Then ' Спецификация найдена на листе сборки
            nNumColumn = swTable.ColumnCount
            If nNumColumn = 7 Then
                mSpecType = 0
                CboType.ListIndex = 0 ' Спецификация
                mChkAssem = 1
                ChkAssem.Value = True
                mSpec = 1
                CmdSort.Enabled = True
                FrmLine.Enabled = True
                CmdFormat.Enabled = True
                CmdAddFormat.Enabled = True
                CmdPosition.Enabled = True
                CmdPosTest.Enabled = True
            End If
        End If
    End If
    If mChkAssem = 0 Then ' Проверяем остальные листы
        For i = 0 To UBound(vSheetNames)
            If vSheetNames(i) = "SP1" Or vSheetNames(i) = "VP1" Then
                ok = swDraw.ActivateSheet(vSheetNames(i))
                If ok Then
                    Set swSheet = swDraw.GetCurrentSheet
                    Set swView = swDraw.GetFirstView
                    If Not swView Is Nothing Then
                        Set swTable = swView.GetFirstTableAnnotation
                        If Not swTable Is Nothing Then ' Спецификация найдена
                            nNumColumn = swTable.ColumnCount
                            If nNumColumn = 7 Then
                                mSpecType = 0
                                CboType.ListIndex = 0 ' Спецификация
                                CmdPosition.Enabled = True
                                CmdPosTest.Enabled = True
                            ElseIf nNumColumn = 11 And vSheetNames(i) = "VP1" Then
                                mSpecType = 2
                                CboType.ListIndex = 2 ' Ведомость покупных
                            Else
                                CboType.ListIndex = 1 ' Групповая спецификация
                                mSpecType = 1
                                Set swBomFeat = swTable.BomFeature
                                'vConfVisibleSP = swBomFeat.GetConfigurations(True, Null)
                                vVisible = Null
                                vConfVisibleSP = swBomFeat.GetConfigurations(True, vVisible)
                                For j = 0 To LstConfig.ListCount - 1
                                    LstConfig.Selected(j) = False
                                    For jj = 0 To UBound(vConfVisibleSP)
                                        If LstConfig.List(j) = vConfVisibleSP(jj) Then
                                            LstConfig.Selected(j) = True
                                            Exit For
                                        End If
                                    Next jj
                                Next j
                                CmdPosition.Enabled = True
                                CmdPosTest.Enabled = True
                            End If
                            mSpec = 1
                            CmdSort.Enabled = True
                            FrmLine.Enabled = True
                            FrmSheet.Enabled = True
                            CmdFormat.Enabled = True
                            CmdAddFormat.Enabled = True
                        End If
                    End If
                End If
            End If
        Next i
    End If
    If mRunDoc = 0 Then ' Первичный запуск или в окне "Дополнения" не было изменений
        ' Проверяем спецификацию
        If mSpec = 1 Then
            ' Читаем таблицу
            ' Раздел Документация
            k = 0 ' Счетчик массива DocData
            m1 = 0 ' Метка считывания строки Сборочный чертеж
            ReDim DocData(0) ' Массив документов раздела документация прочитанных из спецификации
            DocData(0) = "СБ - Сборочный чертеж"
            nNumRow = swTable.RowCount
            nNumColumn = swTable.ColumnCount
 '           Debug.Print "nNumColumn=", nNumColumn
            Debug.Print "nNumRow=", nNumRow
            For i = 1 To nNumRow - 1
                strTemp = swTable.Text(i, 4)
                'Debug.Print "i=", i, "strTemp=", strTemp
                m = 0 ' Метка конца раздела Документация
                For j = 1 To UBound(sSectionData)
                    If strTemp = sSectionData(j) Or InStr(strTemp, "Устанавливают") > 0 Then  ' Раздел Документация закончился
                        m = 1
                    End If
                Next j
                If m = 1 Then
                    Exit For
                End If
                If strTemp = "" Or strTemp = "Документация" Then ' Пропускаем заголовок Документация
                ElseIf strTemp = "Сборочный чертеж" And m1 = 0 Then
                    m1 = 1
                    If prpTestFormat = 0 Then ' Нет считывания формата из чертежа
                        CboFormat.Value = swTable.Text(i, 0)
                        TxtRemark.Value = swTable.Text(i, nNumColumn - 1)
                    Else
                        If swDraw.CustomInfo2("", "CheckFormat") = "True" Or swDraw.CustomInfo2("", "CheckFormat") = "-1" Then
                            CboFormat.Value = swTable.Text(i, 0)
                            TxtRemark.Value = swTable.Text(i, nNumColumn - 1)
                            'Debug.Print "ChkFormat.Value = True"
'                            MForm = 1
'                            ChkFormat.Value = True
'                            MForm = 0
                        End If
                    End If
                Else ' Строка для анализа
                    For j = 0 To n
                        strTemp2 = strTempData(j)
                        strTemp2 = Right$(strTemp2, Len(strTemp2) - InStr(strTemp2, "-"))
                        strTemp2 = Trim(strTemp2)
                        If strTemp = strTemp2 Then ' Строка есть в списке документов
                            If strTemp <> swTable.Text(i - 1, 4) Then ' Проверка для одинаковых документов груп. спец.
                                k = k + 1
                                ReDim Preserve DocData(k)
                                DocData(k) = strTempData(j)
                            End If
                        End If
                    Next j
                End If
            Next i
            If m1 = 0 And CboType.ListIndex = 0 Or m1 = 0 And CboType.ListIndex = 1 Then ' Строки "Сборочный чертеж" не было
                ChkADrw.Value = True
            Else
                ChkADrw.Value = False
            End If
            ' Раздел Комплекты и Электромонтаж
            For i = 1 To nNumRow - 1
                strTemp = swTable.Text(i, 4)
                If strTemp = "Комплекты" Then ' Найден раздел Комплекты
                    mComplect = 1
                End If
                If strTemp = "Устанавливают при электромонтаже" Then ' Найден раздел электромонтаж
                    mElectro = 1
                End If
                If InStr(strTemp, "Устанавливают по") > 0 Then ' Найден раздел электромонтаж
                    If InStr(strTemp, "МЭ") > 0 Then
                        mElectro = 2
                    Else
                        mElectro = 3
                    End If
                End If
            Next i
        End If
    End If

    Tests (0)

    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
        ' Первичное применение
        TxtFirst.Value = swModel.CustomInfo2(sConfigName, prpFirstApplySP)
        ' Эскизное Первичное применение
        TxtDraftFirst.Value = swModel.CustomInfo2(sConfigName, prpDraftFirstApplySP)
        ' Справочный номер
        TxtInform.Value = swModel.CustomInfo2(sConfigName, prpInformNumberSP)
    Else ' Ведомость покупных
        ' Первичное применение
        TxtFirst.Value = swModel.CustomInfo2(sConfigName, prpFirstApply)
        ' Справочный номер
        TxtInform.Value = swModel.CustomInfo2(sConfigName, prpInformNumberVP)
    End If
    If swModel.CustomInfo2(sConfigName, prpLitSP) = "-" Then
        ChkLit.Value = True
    Else
        ChkLit.Value = False
    End If
End If
MType = 0
mRunPref = 1
If prpLeftTopCorner = 1 Then ' Окно макроса в левом верхнем углу
    FrmSpecEditor.Left = 10
    FrmSpecEditor.Top = 10
End If
If prpTopAll = 1 Then ' Окно макроса поверх всех
    KeepFormOnTop
End If
End Sub

Private Sub CmdOk_Click()

' Проверка выбранных конфигураций
If CboType.ListIndex = 1 Then ' Групповая спецификация
    LstConfigTest
    If ConfigTest = 0 Then
        swApp.SendMsgToUser ("Необходимо выбрать хотя бы одно исполнение.")
        Exit Sub
    End If
End If

ImgInfo.Width = 5

MCmdProp = 1
CmdProp_Click
MCmdProp = 0

' Предварительно выставляем параметры документа
ok = swDraw.SetUserPreferenceToggle(swBomTableDontAddQTYNextToConfigName, True)
ok = swDraw.SetUserPreferenceToggle(swDontCopyQTYColumnNameFromTemplate, True)
ok = swDraw.SetUserPreferenceToggle(swOneConfigOnlyTopLevelBom, False)
ok = swDraw.SetUserPreferenceToggle(swDetailingTablesUseTemplateSettings, True)
ok = swDraw.SetUserPreferenceDoubleValue(swDetailingTablesVerticalPadding, 0.00003)
ok = swDraw.SetUserPreferenceIntegerValue(swBomTableZeroQuantityDisplay, swZeroQuantityBlank)

If MSort = 0 Then ' Новая спецификация
    LblInfo.Caption = " Подготовка листов"
    ' Находим и удаляем ранее вставленные листы спецификации и таблицы
    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
        If mChkAssem = 1 Then ' Есть спецификация на листе сборки
            ok = swDraw.ActivateSheet(vSheetNames(0))
            Set swSheet = swDraw.GetCurrentSheet
            Set swView = swDraw.GetFirstView
            If Not swView Is Nothing Then
                swDraw.ClearSelection2 True
                Set swTable = swView.GetFirstTableAnnotation
                If Not swTable Is Nothing Then ' Спецификация найдена
                    Set swAnn = swTable.GetAnnotation
                    ok = swAnn.Select3(False, Nothing)
                    'DeleteOption = SwConst.swDelete_Absorbed + SwConst.swDelete_Children
                    DeleteOption = 3
                    ok = swDraw.Extension.DeleteSelection2(DeleteOption)
                End If
            End If
        End If
        For i = 0 To UBound(vSheetNames)
            ' Проверка имени листа
            If Left$(vSheetNames(i), 2) = "SP" Then
                ok = swDraw.ActivateSheet(vSheetNames(i))
                Set swSheet = swDraw.GetCurrentSheet
                'DeleteOption = SwConst.swDelete_Absorbed + SwConst.swDelete_Children
                DeleteOption = 3
                ok = swDraw.Extension.SelectByID2(swSheet.GetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
                ok = swDraw.Extension.DeleteSelection2(DeleteOption)
            End If
        Next i
    Else ' Ведомость покупных
        ' Удаляем вторые листы
        For i = 0 To UBound(vSheetNames)
            ' Проверка имени листа
            If Left$(vSheetNames(i), 2) = "VP" And Mid$(vSheetNames(i), 3, 1) <> "1" Then
                ok = swDraw.ActivateSheet(vSheetNames(i))
                Set swSheet = swDraw.GetCurrentSheet
                'DeleteOption = SwConst.swDelete_Absorbed + SwConst.swDelete_Children
                DeleteOption = 3
                ok = swDraw.Extension.SelectByID2(swSheet.GetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
                ok = swDraw.Extension.DeleteSelection2(DeleteOption)
            End If
        Next i
        vSheetNames = swDraw.GetSheetNames
        ' Проверяем первый лист
        m = 0
        If UBound(vSheetNames) = 0 Then ' Лист всего один
            If vSheetNames(0) = "VP1" Then ' Переименовываем лист
                m = 1
                ok = swDraw.ActivateSheet(vSheetNames(0))
                Set swSheet = swDraw.GetCurrentSheet
                swSheet.SetName "Temp"
            End If
        Else ' Удаляем первый лист
            For i = 0 To UBound(vSheetNames)
                If Left$(vSheetNames(i), 3) = "VP1" Then
                    ok = swDraw.ActivateSheet(vSheetNames(i))
                    Set swSheet = swDraw.GetCurrentSheet
                    'DeleteOption = SwConst.swDelete_Absorbed + SwConst.swDelete_Children
                    DeleteOption = 3
                    ok = swDraw.Extension.SelectByID2(swSheet.GetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
                    ok = swDraw.Extension.DeleteSelection2(DeleteOption)
                    Exit For
                End If
            Next i
        End If
    End If
    vSheetNames = swDraw.GetSheetNames

    If ChkAssem.Value = False Then ' Нет спецификации на листе сборки
        ' Добавляем лист
        If CboType.ListIndex = 0 Then ' Спецификация
            vRetval = swDraw.NewSheet3("SP1", swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource2, 0.21, 0.297, "По умолчанию")
        ElseIf CboType.ListIndex = 1 Then ' Групповая спецификация
            If mConfigCount = 0 Then
                vRetval = swDraw.NewSheet3("SP1", swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource6, 0.297, 0.21, "По умолчанию")
            Else
                vRetval = swDraw.NewSheet3("SP1", swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource6, 0.297, 0.21, "По умолчанию")
            End If
        Else ' Ведомость покупных
                vRetval = swDraw.NewSheet3("VP1", swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource12, 0.42, 0.297, "По умолчанию")
                If m = 1 Then ' Удаляем прежний VP1
                    ok = swDraw.ActivateSheet("Temp")
                    Set swSheet = swDraw.GetCurrentSheet
                    'DeleteOption = SwConst.swDelete_Absorbed + SwConst.swDelete_Children
                    DeleteOption = 3
                    ok = swDraw.Extension.SelectByID2(swSheet.GetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
                    ok = swDraw.Extension.DeleteSelection2(DeleteOption)
                End If
        End If
        'vRetval = swDraw.SetupSheet4("SP1", swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource2, 0.21, 0.297, "")
        Set swSheet = swDraw.GetCurrentSheet
        swSheet.SheetFormatVisible = True

        ' Вставляем вид
        Set swView = swDraw.CreateDrawViewFromModelView3(swModel.GetPathName, vModelViewNames(0), -0.1, 0, 0)
        swView.ReferencedConfiguration = sConfigName
        swDraw.SuppressView
    End If
    LblInfo.Caption = " Вставка таблицы"
    ' Вставляем таблицу
    If CboType.ListIndex = 0 Then ' Спецификация
        If ChkAssem.Value = True Then ' Есть спецификация на листе сборки
            ok = swDraw.ActivateSheet(vSheetNames(0))
            Set swSheet = swDraw.GetCurrentSheet
            Set swView = swDraw.GetFirstView
            If swSheet.CustomPropertyView = "По умолчанию" Or swSheet.CustomPropertyView = "Default" Then
                Set swView = swView.GetNextView ' Получаем первый вид
            Else
                Do Until swView Is Nothing
                    If swView.GetName2 = swSheet.CustomPropertyView Then
                        Exit Do
                    End If
                    Set swView = swView.GetNextView
                Loop
            End If
            vSheetProps = swSheet.GetProperties
            Set swBomTable = swView.InsertBomTable4(True, vSheetProps(5) - 0.005, 0.068, swBOMConfigurationAnchor_BottomRight, swBomType_TopLevelOnly, sConfigName, sSource1, False, swNumberingType_e.swIndentedBOMNotSet, False)
            Set swBomFeat = swBomTable.BomFeature ' ********
            ReDim sTemp(0)
            sTemp(0) = sConfigName
            vConfVisible = sTemp
            vVisible = Null
            bRetval = swBomFeat.SetConfigurations(True, vVisible, vConfVisible)
            swBomFeat.DisplayAsOneItem = True '***********
            swBomFeat.PartConfigurationGrouping = swDisplay_ConfigurationWithSameName_AsOneItem
        Else
            Set swBomTable = swView.InsertBomTable4(True, 0.02, 0.292, swBOMConfigurationAnchor_TopLeft, swBomType_TopLevelOnly, sConfigName, sSource1, False, swNumberingType_e.swIndentedBOMNotSet, False)
            Set swBomFeat = swBomTable.BomFeature ' ********
            ReDim sTemp(0)
            sTemp(0) = sConfigName
            vConfVisible = sTemp
            vVisible = Null
            bRetval = swBomFeat.SetConfigurations(True, vVisible, vConfVisible)
            swBomFeat.DisplayAsOneItem = True '***********
            swBomFeat.PartConfigurationGrouping = swDisplay_ConfigurationWithSameName_AsOneItem
        End If
    ElseIf CboType.ListIndex = 1 Then ' Групповая спецификация
        Set swBomTable = swView.InsertBomTable2(True, 0.005, 0.19, swBOMConfigurationAnchor_TopLeft, swBomType_TopLevelOnly, sConfigName, sSource1)
        Set swBomFeat = swBomTable.BomFeature
        swBomFeat.DisplayAsOneItem = True '***********
        swBomFeat.PartConfigurationGrouping = swDisplay_ConfigurationWithSameName_AsOneItem
    Else ' Ведомость покупных
       ' Set swBomTable = swView.InsertBomTable2(True, 0.02, 0.292, swBOMConfigurationAnchor_TopLeft, swBomType_Indented, sConfigName, sSource11)
        Set swBomTable = swView.InsertBomTable4(True, 0.02, 0.292, swBOMConfigurationAnchor_TopLeft, swBomType_PartsOnly, sConfigName, sSource11, False, swNumberingType_e.swIndentedBOMNotSet, False)
        Set swBomFeat = swBomTable.BomFeature
        ReDim sTemp(0)
        sTemp(0) = sConfigName
        vConfVisible = sTemp
        vVisible = Null
        bRetval = swBomFeat.SetConfigurations(True, vVisible, vConfVisible)
        swBomFeat.DisplayAsOneItem = True '***********
        swBomFeat.PartConfigurationGrouping = swDisplay_ConfigurationWithSameName_AsOneItem
    End If
    Set swTable = swBomTable
End If

If CboType.ListIndex = 1 Then ' Групповая спецификация
    ' Устанавливаем исполнения для групповой спецификации
    j = 0
    For i = 0 To LstConfig.ListCount - 1
        If LstConfig.Selected(i) = True Then
            ReDim Preserve sTemp(j)
            sTemp(j) = vConfNameArr(i)
            j = j + 1
        End If
    Next i
    vConfVisible = sTemp
    vVisible = Null
    bRetval = swBomFeat.SetConfigurations(True, vVisible, vConfVisible)

    ' Сортируем столбцы с количеством
    ' Получаем заголовки столбцов
    ReDim sTemp(UBound(vConfVisible))
    For i = 0 To UBound(vConfVisible)
        sTemp(i) = swTable.GetColumnTitle(i + 5)
    Next i
    ' Сопоставляем столбцы с конфигурациями
    For i = 0 To UBound(vConfVisible)
        m = 0
        For j = 1 To UBound(vConfVisible)
            If vConfVisible(i) = sTemp(j) Then
                m = 1
                Exit For
            End If
        Next j
        If m = 0 Then
            ok = swTable.SetColumnTitle(5, vConfVisible(i))
            Exit For
        End If
    Next i
    ' Перемещаем столбцы таблицы
    For i = UBound(vConfVisible) To 0 Step -1
        For j = 1 To UBound(vConfVisible)
            If swTable.GetColumnTitle(5 + j) = vConfVisible(i) Then
                ok = swTable.MoveColumn(5 + j, swTableItemInsertPosition_After, 4)
                Exit For
            End If
        Next j
    Next i
End If

ImgInfo.Width = 40
LblInfo.Caption = " Подготовка таблицы"

' Скрываем таблицу
Set swAnn = swTable.GetAnnotation
swAnn.Visible = swAnnotationHidden

' Назначение заголовков столбцов
nNumColumn = swTable.ColumnCount
If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    ok = swTable.SetColumnCustomProperty(0, prpFormat) ' Формат
    If sNumber = "1" Then ' Обозначение
        ok = swTable.SetColumnType(3, swBomTableColumnType_PartNumber)
        'ok = swTable.SetColumnUseTitleAsPartNumber(3, True)
    Else
        ok = swTable.SetColumnCustomProperty(3, prpNumber)
    End If
    If sDescription = "1" Then ' Наименование
        ok = swTable.SetColumnType(4, swBomTableColumnType_PartNumber)
        'ok = swTable.SetColumnUseTitleAsPartNumber(4, True)
    Else
        ok = swTable.SetColumnCustomProperty(4, prpDescription)
    End If
    ok = swTable.SetColumnCustomProperty(nNumColumn - 1, prpRemark) ' Примечание
Else ' Ведомость покупных
    ok = swTable.SetColumnCustomProperty(1, prpDescriptionVP) ' Наименование для ВП
    ok = swTable.SetColumnCustomProperty(2, prpProductCodeVP) ' Код продукции
    ok = swTable.SetColumnCustomProperty(3, prpNumberDocVP) ' Обозначение документа на поставку
    ok = swTable.SetColumnCustomProperty(4, prpVendorVP) ' Поставщик
    ok = swTable.SetColumnCustomProperty(nNumColumn - 1, prpRemarkVP) ' Примечание для ВП
End If

' Добавляем/удаляем дополнительные пустые колонки для групповой спецификации
If CboType.ListIndex = 1 Then ' Групповая спецификация
    If nNumColumn > 16 Then
        For i = 0 To nNumColumn - 16 - 1
            ok = swTable.DeleteColumn(14)
        Next i
    ElseIf nNumColumn < 16 Then
        For i = 0 To 16 - nNumColumn - 1
            ok = swTable.InsertColumn(swTableItemInsertPosition_After, nNumColumn - 2, "")
            ok = swTable.SetColumnType(swTable.ColumnCount - 2, swWeldTableColumnType_CustomProperty)
        Next i
    End If
End If

' Добавляем временные колонки
ok = swTable.InsertColumn(swTableItemInsertPosition_Last, 0, "Имя папки")
ok = swTable.SetColumnType(swTable.ColumnCount - 1, swWeldTableColumnType_CustomProperty)
dRetval = swTable.SetColumnWidth(swTable.ColumnCount - 1, 0.2, swTableRowColChange_TableSizeCanChange)
strTemp = "SW-Имя папки(Folder Name)"
ok = swTable.SetColumnCustomProperty(swTable.ColumnCount - 1, strTemp)

ok = swTable.InsertColumn(swTableItemInsertPosition_Last, 0, "Имя файла")
ok = swTable.SetColumnType(swTable.ColumnCount - 1, swWeldTableColumnType_CustomProperty)
dRetval = swTable.SetColumnWidth(swTable.ColumnCount - 1, 0.2, swTableRowColChange_TableSizeCanChange)
strTemp = "SW-Имя файла(File Name)"
ok = swTable.SetColumnCustomProperty(swTable.ColumnCount - 1, strTemp)

ok = swTable.InsertColumn(swTableItemInsertPosition_Last, 0, prpSection)
ok = swTable.SetColumnType(swTable.ColumnCount - 1, swWeldTableColumnType_CustomProperty)
dRetval = swTable.SetColumnWidth(swTable.ColumnCount - 1, 0.2, swTableRowColChange_TableSizeCanChange)
ok = swTable.SetColumnCustomProperty(swTable.ColumnCount - 1, prpSection)

ok = swTable.InsertColumn(swTableItemInsertPosition_Last, 0, prpGroup)
ok = swTable.SetColumnType(swTable.ColumnCount - 1, swWeldTableColumnType_CustomProperty)
dRetval = swTable.SetColumnWidth(swTable.ColumnCount - 1, 0.2, swTableRowColChange_TableSizeCanChange)
ok = swTable.SetColumnCustomProperty(swTable.ColumnCount - 1, prpGroup)

ok = swTable.InsertColumn(swTableItemInsertPosition_Last, 0, prpBlank) ' Заготовка
ok = swTable.SetColumnType(swTable.ColumnCount - 1, swWeldTableColumnType_CustomProperty)
dRetval = swTable.SetColumnWidth(swTable.ColumnCount - 1, 0.2, swTableRowColChange_TableSizeCanChange)
ok = swTable.SetColumnCustomProperty(swTable.ColumnCount - 1, prpBlank)

ok = swTable.InsertColumn(swTableItemInsertPosition_Last, 0, prpBor) ' Заимствование
ok = swTable.SetColumnType(swTable.ColumnCount - 1, swWeldTableColumnType_CustomProperty)
dRetval = swTable.SetColumnWidth(swTable.ColumnCount - 1, 0.2, swTableRowColChange_TableSizeCanChange)
ok = swTable.SetColumnCustomProperty(swTable.ColumnCount - 1, prpBor)

ok = swTable.InsertColumn(swTableItemInsertPosition_Last, 0, "Номер_SP")
ok = swTable.SetColumnType(swTable.ColumnCount - 1, swWeldTableColumnType_CustomProperty)
dRetval = swTable.SetColumnWidth(swTable.ColumnCount - 1, 0.2, swTableRowColChange_TableSizeCanChange)

ImgInfo.Width = 80
LblInfo.Caption = " Чтение таблицы"

'Считываем таблицу
nNumRow = swTable.RowCount
nNumColumn = swTable.ColumnCount
' Нулевая строка массива sSpecData соответствует первой строке реальной таблицы
ReDim sSpecData(nNumRow + 100, nNumColumn)   ' Последний столбец для отметки самопальных строк
ReDim strTempData1(nNumRow + 100, nNumColumn)   ' Массив-дублер для sSpecDataSize
Set fs = CreateObject("Scripting.FileSystemObject")
k = 0 ' Счетчик строк sSpecData
k1 = 0 ' Счетчик считанных строк таблицы
k2 = -1 ' Счетчик строк ComplectData
n = 0 ' Счетчик удаленных строк
ReDim ComplectData(nNumRow, nNumColumn - 8)
For i = 0 To nNumRow - 2 - n ' (-1 т.к с 0, -1 т.к. пропускаем первую строку таблицы)
    ' Проверяем заголовки разделов и удаляем их
    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
        strTemp = swTable.Text(k1 + 1, 4)
        Set swTextFormatTest = swTable.GetCellTextFormat(k1 + 1, 4)
        m = 0
        For j = 1 To UBound(sSectionData) ' С 1, т.к. первая строка Документация
            If strTemp = sSectionData(j) Then
                m = 1
                ok = swTable.DeleteRow(k1 + 1)
                l = j
            End If
        Next j
        If m <> 1 And InStr(strTemp, "Устанавливают") > 0 And swTextFormatTest.Underline Then ' Найден раздел электромонтаж
            m = 1
            ok = swTable.DeleteRow(k1 + 1)
        End If
    Else ' Ведомость покупных
        strTemp = swTable.Text(k1 + 1, 1)
        m = 0
        For j = 0 To UBound(sGroupData)
            If strTemp = sGroupData(j) Then
                m = 1
                ok = swTable.DeleteRow(k1 + 1)
                l = j
            End If
        Next j
    End If
    If m = 0 Then ' Строка рядовая
        sSpecData(k, nNumColumn - 1) = k ' Номер строки
        swTable.Text(k1 + 1, nNumColumn - 1) = k ' Номер строки
        For j = 0 To nNumColumn - 2  ' Последний - столбец Заимствование
            sSpecData(k, j) = swTable.Text(k1 + 1, j) ' Первую строку таблицы пропускаем
            If j = nNumColumn - 5 Then ' Проверка свойства раздел
                If sSpecData(k, nNumColumn - 5) = "" Then ' Раздел пустой
                    If MSort = 1 And swTable.Text(k1 + 1, nNumColumn - 6) = "" Then ' Ручной ввод при наличии спецификации
                        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                            If sSectionData(l) = "Комплекты" Then ' Комплекты
                                If mComplect = 1 Then ' Раздел Комплекты включен
                                    k2 = k2 + 1
                                    For jj = 0 To nNumColumn - 8
                                        ComplectData(k2, jj) = swTable.Text(k1 + 1, jj)
                                    Next jj
                                End If
                                m = 1
                            Else
                                m = 2
                            End If
                            ' Назначаем раздел
                            sSpecData(k, nNumColumn - 5) = sSectionData(l)
                            If k > 0 Then
                                If sSpecData(k - 1, nNumColumn - 4) <> "" Then
                                    If sSpecData(k, nNumColumn - 5) = "Прочие изделия" Or sSpecData(k, nNumColumn - 5) = "Стандартные изделия" Or _
                                        sSpecData(k, nNumColumn - 5) = "ЭМ-Прочие изделия" Or sSpecData(k, nNumColumn - 5) = "ЭМ-Стандартные изделия" Or _
                                        sSpecData(k, nNumColumn - 5) = "Материалы" Or sSpecData(k, nNumColumn - 5) = "ЭМ-Материалы" Then
                                            sSpecData(k, nNumColumn - 4) = sSpecData(k - 1, nNumColumn - 4)
                                    End If
                                End If
                            End If
                            ok = swTable.DeleteRow(k1 + 1) ' Удаляем ручную строку
                            Exit For
                        Else ' Ведомость покупных
                            ' Назначаем раздел "Прочие изделия" и группу
                            m = 2
                            sSpecData(k, nNumColumn - 5) = "Прочие изделия"
                            sSpecData(k, nNumColumn - 4) = sGroupData(l)
                            ok = swTable.DeleteRow(k1 + 1) ' Удаляем ручную строку
                            Exit For
                        End If
                    Else ' Проверка наличия файла
                        strTemp = sSpecData(k, nNumColumn - 7) & sSpecData(k, nNumColumn - 6) & ".SLDASM"
                        If fs.FileExists(strTemp) = True Then
                            sSpecData(k, j) = "Сборочные единицы"
                        Else
                            sSpecData(k, j) = "Детали"
                        End If
                    End If
                End If
                If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                    If sSpecData(k, j) = "Сборочные единицы" Then ' Заменяем формат у сборок
                        sSpecData(k, 0) = "A4"
                        swTable.Text(k1 + 1, 0) = "A4"
                    End If
                Else ' Ведомость покупных
                    If sSpecData(k, nNumColumn - 5) = "Прочие изделия" Or sSpecData(k, nNumColumn - 5) = "Стандартные изделия" Then
                    Else
                        Debug.Print swTable.Text(k1 + 1, 12), swTable.Text(k1 + 1, 13)
                        If swTable.Text(k1 + 1, nNumColumn - 3) = "" Then ' нет заготовки
                            m = 1
                            ok = swTable.DeleteRow(k1 + 1) ' Удаляем строку другого раздела
                            Exit For
                        End If
                        Debug.Print swTable.Text(k1 + 1, nNumColumn - 3)
                    End If
                End If
            ElseIf j = nNumColumn - 3 And MSort = 0 Then ' Заготовка
                If sSpecData(k, nNumColumn - 3) <> "" Then ' Есть заготовка
                    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then ' Спецификация или Групповая спецификация
                        m = 3
                        strTemp = sSpecData(k, nNumColumn - 3)
                        varTemp = InStr(strTemp, "$")
                        If varTemp > 0 Then
                            If varTemp > 1 Then
                                sSpecData(k + 1, 0) = Left$(strTemp, varTemp - 1) ' Формат
                            Else
                                sSpecData(k + 1, 0) = ""
                            End If
                            strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                            varTemp = InStr(strTemp, "$")
                            If varTemp > 0 Then
                                If varTemp > 1 Then
                                    sSpecData(k + 1, 3) = Left$(strTemp, varTemp - 1) ' Обозначение
                                Else
                                    sSpecData(k + 1, 3) = ""
                                End If
                                strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                varTemp = InStr(strTemp, "$")
                                If varTemp > 0 Then
                                    If varTemp > 1 Then
                                        sSpecData(k + 1, 4) = Left$(strTemp, varTemp - 1) & " (Заготовка для " & sSpecData(k, 3) & ")" ' Наименование
                                    Else
                                        sSpecData(k + 1, 4) = ""
                                    End If
                                    strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                    varTemp = InStr(strTemp, "$")
                                    If varTemp > 0 Then
                                        If varTemp > 1 Then
                                            sSpecData(k + 1, nNumColumn - 8) = Left$(strTemp, varTemp - 1) ' Примечание
                                        Else
                                            sSpecData(k + 1, nNumColumn - 8) = ""
                                        End If
                                        strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                        varTemp = InStr(strTemp, "$")
                                        If varTemp > 0 Then
                                            If varTemp > 1 Then
                                                sSpecData(k + 1, nNumColumn - 5) = Left$(strTemp, varTemp - 1) ' Раздел
                                            Else
                                                sSpecData(k + 1, nNumColumn - 5) = sSpecData(k, nNumColumn - 5)
                                            End If
                                            strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                            varTemp = InStr(strTemp, "$")
                                            If varTemp > 0 Then
                                                If varTemp > 1 Then
                                                    sSpecData(k + 1, nNumColumn - 4) = Left$(strTemp, varTemp - 1) ' Группа
                                                Else
                                                    sSpecData(k + 1, nNumColumn - 4) = sSpecData(k, nNumColumn - 4)
                                                End If
                                            End If
                                            strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                            varTemp = InStr(strTemp, "$")
                                            If varTemp > 0 Then
                                                If varTemp > 1 And sSpecData(k + 1, 4) <> "" Then
                                                    strTemp = Left$(strTemp, varTemp - 1) ' Обозначение ДНП
                                                    If sSpecData(k + 1, nNumColumn - 5) = "Прочие изделия" Or sSpecData(k + 1, nNumColumn - 5) = "Стандартные изделия" Then ' Меняем Наименование
                                                        varTemp = InStr(sSpecData(k + 1, 4), " (Заготовка")
                                                        If varTemp > 0 Then
                                                            sSpecData(k + 1, 4) = Left$(sSpecData(k + 1, 4), varTemp) & strTemp & Right$(sSpecData(k + 1, 4), Len(sSpecData(k + 1, 4)) - varTemp + 1)
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                        sSpecData(k + 1, 2) = "-" ' Позиция
                    Else ' Ведомость покупных
                        m = 4
                        strTemp = sSpecData(k, nNumColumn - 3)
                        varTemp = InStr(strTemp, "$")
                        If varTemp > 0 Then
                            strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                            varTemp = InStr(strTemp, "$")
                            If varTemp > 0 Then
                                strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                varTemp = InStr(strTemp, "$")
                                If varTemp > 0 Then
                                    If varTemp > 1 Then
                                        sSpecData(k + 1, 1) = Left$(strTemp, varTemp - 1) ' Наименование
                                    Else
                                        sSpecData(k + 1, 1) = ""
                                    End If
                                    strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                    varTemp = InStr(strTemp, "$")
                                    If varTemp > 0 Then
                                        strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                        varTemp = InStr(strTemp, "$")
                                        If varTemp > 0 Then
                                            If varTemp > 1 Then
                                                sSpecData(k + 1, nNumColumn - 5) = Left$(strTemp, varTemp - 1) ' Раздел
                                            Else
                                                sSpecData(k + 1, nNumColumn - 5) = sSpecData(k, nNumColumn - 5)
                                            End If
                                            strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                            varTemp = InStr(strTemp, "$")
                                            If varTemp > 0 Then
                                                If varTemp > 1 Then
                                                    sSpecData(k + 1, nNumColumn - 4) = Left$(strTemp, varTemp - 1) ' Группа
                                                Else
                                                    sSpecData(k + 1, nNumColumn - 4) = sSpecData(k, nNumColumn - 4)
                                                End If
                                                strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                                varTemp = InStr(strTemp, "$")
                                                If varTemp > 0 Then
                                                    If varTemp > 1 Then
                                                        sSpecData(k + 1, 3) = Left$(strTemp, varTemp - 1) ' Обозначение ДНП
                                                        If Right$(sSpecData(k + 1, 1), Len(sSpecData(k + 1, 3))) = sSpecData(k + 1, 3) Then
                                                            sSpecData(k + 1, 1) = Trim(Left$(sSpecData(k + 1, 1), Len(sSpecData(k + 1, 1)) - Len(sSpecData(k + 1, 3))))
                                                        End If
                                                    Else
                                                        sSpecData(k + 1, 3) = ""
                                                    End If
                                                    strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                                    varTemp = InStr(strTemp, "$")
                                                    If varTemp > 0 Then
                                                        If varTemp > 1 Then
                                                            sSpecData(k + 1, nNumColumn - 8) = Left$(strTemp, varTemp - 1) ' Примечание ВП
                                                        Else
                                                            sSpecData(k + 1, nNumColumn - 8) = ""
                                                        End If
                                                        strTemp = Right$(strTemp, Len(strTemp) - varTemp)
                                                        varTemp = InStr(strTemp, "$")
                                                        If varTemp > 0 Then
                                                            If varTemp > 1 Then
                                                                sSpecData(k + 1, 4) = Left$(strTemp, varTemp - 1) ' Поставщик
                                                            Else
                                                                sSpecData(k + 1, 4) = ""
                                                            End If
                                                            sSpecData(k + 1, 2) = Right$(strTemp, Len(strTemp) - varTemp) ' Код продукции
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                    sSpecData(k + 1, nNumColumn - 1) = k + 1 ' Номер строки
                    sSpecData(k + 1, nNumColumn) = 1 ' Ручная строка
                    If CboType.ListIndex = 0 Then ' Спецификация
                        sSpecData(k + 1, 5) = sSpecData(k, 5)  ' Количество
                    ElseIf CboType.ListIndex = 1 Then  ' Групповая спецификация
                        For jj = 5 To 14
                            sSpecData(k + 1, jj) = sSpecData(k, jj)  ' Количество
                        Next jj
                    Else ' Ведомость покупных
                        sSpecData(k + 1, 6) = sSpecData(k, 6)  ' Количество
                    End If
                End If
            End If
        Next j
    End If
    If m = 0 Then
        sSpecData(k, nNumColumn) = 0 ' Нормальная строка
        k = k + 1
        k1 = k1 + 1
    ElseIf m = 1 Then ' Строка из отдела Комплекты или строка другого раздела ВП
        n = n + 1
    ElseIf m = 2 Then ' Ручная строка
        sSpecData(k, nNumColumn) = 1 ' Ручная строка
        k = k + 1
        n = n + 1
    ElseIf m = 3 Then ' Заготовка
        sSpecData(k, nNumColumn) = 0
        k = k + 2
        k1 = k1 + 1
    Else ' Заготовка и ВП
        If sSpecData(k, nNumColumn - 5) = "Прочие изделия" Or sSpecData(k, nNumColumn - 5) = "Стандартные изделия" Then
            sSpecData(k, nNumColumn) = 0
            k = k + 2
            k1 = k1 + 1
        Else
            ok = swTable.DeleteRow(k1 + 1) ' Удаляем строку другого раздела
            For j = 0 To nNumColumn
                sSpecData(k, j) = sSpecData(k + 1, j)
            Next j
            n = n + 1
            k = k + 1
        End If
    End If
Next i
sSpecDataSize = k - 1
ComplectDataSize = k2

Debug.Print "Из таблицы считали ", k, " строк"
For i = 0 To sSpecDataSize
    Debug.Print sSpecData(i, 1), sSpecData(i, nNumColumn - 4) ', sSpecData(i, nNumColumn - 1), sSpecData(i, nNumColumn)
Next i

' Освобождаем позиции
Set swBomFeat = swTable.BomFeature
swBomFeat.KeepCurrentItemNumbers = False

' Борьба с переколбасом (для существующих таблиц у которых пользователь перемещал строки)
nNumRow = swTable.RowCount
k = 1
While k = 1
    k = 0
    For i = 2 To nNumRow - 1
    If swTable.Text(i, nNumColumn - 1) < i - 1 Then
        ok = swTable.MoveRow(i, swTableItemInsertPosition_First, i - 1)
        k = 1
        Exit For
    End If
    Next i
Wend

ImgInfo.Width = 120
LblInfo.Caption = " Сортировка"
'Вызываем процедуру сортировки
If iSort = 1 Then ' Новая сортировка
    nNumRow = swTable.RowCount
    Debug.Print "nNumRow", nNumRow
    k = 1 ' Метка конца цикла
    n = 0
    strTempData1 = sSpecData
    While k = 1
        k = 0
        For i = 0 To sSpecDataSize - 1 ' (-1 т.к. берем сразу две строки)
            Sort
            If Result = "S_GREAT" Then
                k = 1
                If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                    ' Проверяем верхнюю строку
                    k1 = 0 ' Счетчик строк с одинаковыми позициями вверх
                    If i <> 0 Then
                        For j = i To 1 Step -1  ' Проверяем строки с одинаковыми позициями
                            If sSpecData(j, 2) = " " Or sSpecData(j, 2) = "-" Then ' Пустая позиция
                                Exit For
                            Else
                                If sSpecData(j, 2) = sSpecData(j - 1, 2) Then
                                    k1 = k1 + 1 ' Количество строк с одинаковыми позициями (с нуля)
                                Else
                                    Exit For
                                End If
                            End If
                        Next j
                    End If
                    ' Проверяем нижнюю строку
                    k2 = 0 ' Счетчик строк с одинаковыми позициями вниз
                    For j = i + 1 To sSpecDataSize - 2 ' Проверяем строки с одинаковыми позициями
                        If sSpecData(j, 2) = " " Or sSpecData(j, 2) = "-" Then  ' Пустая позиция
                            Exit For
                        Else
                            If sSpecData(j, 2) = sSpecData(j + 1, 2) Then
                                k2 = k2 + 1 ' Количество строк с одинаковыми позициями (с нуля)
                            Else
                                Exit For
                            End If
                        End If
                    Next j
                Else ' Ведомость покупных
                    k1 = 0
                    k2 = 0
                End If
                ' Перемещаем строки в sSpecData
                ' Верхнюю строку вниз
                For jj = i - k1 To i
                    For j = 0 To nNumColumn
                        strTempData1(jj + k2 + 1, j) = sSpecData(jj, j)
                    Next j
                Next jj
                ' Нижнюю строку вверх
                For jj = i + 1 To i + 1 + k2
                    For j = 0 To nNumColumn
                        strTempData1(jj - k1 - 1, j) = sSpecData(jj, j)
                    Next j
                Next jj
                sSpecData = strTempData1
            End If
        Next i
        n = n + 1
        If n = 200 Then
    '        swDraw.ForceRebuild3 (True)
    '        n = 0
        End If
    Wend
    ' Перемещаем строки таблицы
    For i = sSpecDataSize To 0 Step -1
        If sSpecData(i, nNumColumn) = 0 Then  ' Проверяем удаленные самопальные строки
            'Debug.Print "Перемещаем строку таблицы", i
            For j = 1 To nNumRow - 1
                If swTable.Text(j, nNumColumn - 1) = sSpecData(i, nNumColumn - 1) Then
                    strTemp = swTable.Text(j, nNumColumn - 1)
                    Debug.Print "Перемещаем строку", swTable.Text(j, 4), swTable.Text(j, nNumColumn - 1), sSpecData(i, nNumColumn - 1)
                    ok = swTable.MoveRow(j, swTableItemInsertPosition_First, 0) ' Перемещаем строку
                    Exit For
                End If
            Next j
        End If
        ' Debug.Print ok, "Move", "i=", i
    Next i
Else ' Старая сортировка
    nNumRow = swTable.RowCount
    Debug.Print "nNumRow", nNumRow
    k = 1 ' Метка конца цикла
    n = 0
    strTempData1 = sSpecData
    While k = 1
        k = 0
        For i = 0 To sSpecDataSize - 1 ' (-1 т.к. берем сразу две строки)
            Sort
            If Result = "S_GREAT" Then
                k = 1
                If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                    ' Проверяем верхнюю строку
                    k1 = 0 ' Счетчик строк с одинаковыми позициями вверх
                    If i <> 0 Then
                        For j = i To 1 Step -1  ' Проверяем строки с одинаковыми позициями
                            If sSpecData(j, 2) = " " Or sSpecData(j, 2) = "-" Then  ' Пустая позиция
                                Exit For
                            Else
                                If sSpecData(j, 2) = sSpecData(j - 1, 2) Then
                                    k1 = k1 + 1 ' Количество строк с одинаковыми позициями (с нуля)
                                Else
                                    Exit For
                                End If
                            End If
                        Next j
                    End If
                    ' Проверяем нижнюю строку
                    k2 = 0 ' Счетчик строк с одинаковыми позициями вниз
                    For j = i + 1 To sSpecDataSize - 2 ' Проверяем строки с одинаковыми позициями
                        If sSpecData(j, 2) = " " Or sSpecData(j, 2) = "-" Then  ' Пустая позиция
                            Exit For
                        Else
                            If sSpecData(j, 2) = sSpecData(j + 1, 2) Then
                                k2 = k2 + 1 ' Количество строк с одинаковыми позициями (с нуля)
                            Else
                                Exit For
                            End If
                        End If
                    Next j
                Else ' Ведомость покупных
                    k1 = 0
                    k2 = 0
                End If
                ' Перемещаем строки таблицы
                If sSpecData(i, nNumColumn) = 0 And sSpecData(i + 1, nNumColumn) = 0 Then ' Проверяем удаленные самопальные строки
                    'Debug.Print "Перемещаемые строки таблицы", i, i + 1
                    For j = 1 To nNumRow - 1
                        If swTable.Text(j, nNumColumn - 1) = sSpecData(i, nNumColumn - 1) Then
                            strTemp = swTable.Text(j, nNumColumn - 1)
                            Debug.Print "Перемещаем строку", swTable.Text(j, 4), swTable.Text(j, nNumColumn - 1), sSpecData(i, nNumColumn - 1)
                            ok = swTable.MoveRow(j, swTableItemInsertPosition_After, j + 1) ' Перемещаем строку
                            ' Проверяем, не помешала ли перемещению удаленная строка таблицы (особенно актуально для ВП)
                            l = 0
                            While l = 0
                                If swTable.Text(j, nNumColumn - 1) = strTemp Then
                                    Debug.Print "Перемещаем строку", swTable.Text(j, 4), swTable.Text(j, nNumColumn - 1), sSpecData(i, nNumColumn - 1)
                                    ok = swTable.MoveRow(j, swTableItemInsertPosition_After, j + 1) ' Перемещаем строку
                                Else
                                    l = 1
                                End If
                            Wend
                            Exit For
                        End If
                    Next j
                End If
                ' Debug.Print ok, "Move", "i=", i
                ' Перемещаем строки в sSpecData
                ' Верхнюю строку вниз
                For jj = i - k1 To i
                    For j = 0 To nNumColumn
                        strTempData1(jj + k2 + 1, j) = sSpecData(jj, j)
                    Next j
                Next jj
                ' Нижнюю строку вверх
                For jj = i + 1 To i + 1 + k2
                    For j = 0 To nNumColumn
                        strTempData1(jj - k1 - 1, j) = sSpecData(jj, j)
                    Next j
                Next jj
                sSpecData = strTempData1
            End If
        Next i
        n = n + 1
        If n = 200 Then
    '        swDraw.ForceRebuild3 (True)
    '        n = 0
        End If
    Wend
End If

'Debug.Print "После сортировки"
'For i = 0 To sSpecDataSize
'    Debug.Print sSpecData(i, 1), sSpecData(i, nNumColumn - 4) ', sSpecData(i, nNumColumn - 1)
'Next i

ImgInfo.Width = 200
LblInfo.Caption = " Добавление дополнительных строк"

' Добавляем удаленные самопальные строки
For i = 0 To sSpecDataSize
    If sSpecData(i, nNumColumn) = 1 And sSpecData(i, 2) <> "-" Then ' Вставляем строку
        ok = swTable.InsertRow(swTableItemInsertPosition_After, i)
        For j = 0 To nNumColumn - 8
            If j <> 2 Then
                swTable.Text(i + 1, j) = sSpecData(i, j)
            End If
        Next j
    End If
Next i

' Фиксируем номера позиций
'Set swBomFeat = swTable.BomFeature
'swBomFeat.KeepCurrentItemNumbers = True

' Добавляем удаленные строки Заготовки
For i = 0 To sSpecDataSize
    If sSpecData(i, nNumColumn) = 1 And sSpecData(i, 2) = "-" Then ' Вставляем строку
        ok = swTable.InsertRow(swTableItemInsertPosition_After, i)
        For j = 0 To nNumColumn - 8
            swTable.Text(i + 1, j) = sSpecData(i, j)
        Next j
    End If
Next i

' Удаляем временные колонки
ok = swTable.DeleteColumn(nNumColumn - 1)
ok = swTable.DeleteColumn(nNumColumn - 2)
ok = swTable.DeleteColumn(nNumColumn - 3)
ok = swTable.DeleteColumn(nNumColumn - 4)
ok = swTable.DeleteColumn(nNumColumn - 5)
ok = swTable.DeleteColumn(nNumColumn - 6)
ok = swTable.DeleteColumn(nNumColumn - 7)
nNumColumn = swTable.ColumnCount

ImgInfo.Width = 240

LblInfo.Caption = " Добавление разделов"

nNumRow = swTable.RowCount
If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    ' Вставляем заголовки разделов
    Set swTextFormat = swTable.GetCellTextFormat(1, 4)
    Set swTextFormatUnd = swTable.GetCellTextFormat(1, 4)
    swTextFormatUnd.Underline = True
    k = 0
    m = 0
    For j = 0 To UBound(sSectionData)
        For i = 0 To nNumRow - 2 ' (-1 т.к с 0, -1 т.к. пропускаем первую строку)
            Debug.Print sSpecData(i, 4), sSpecData(i, nNumColumn + 2)
            If sSpecData(i, nNumColumn + 2) = sSectionData(j) Then
                If Left$(sSectionData(j), 3) = "ЭМ-" And m = 0 Then ' Вставляем Заголовок Электромонтаж
                    If sNumber = "1" Then ' Обозначение
                        strTemp = sNumberText
                        If sNumberText = sModelName Then
                            strTemp = "$PRPSHEET:" & Chr$(34) & "SW-File Name" & Chr$(34)
                        End If
                    Else
                        strTemp = "$PRPSHEET:" & Chr$(34) & prpNumber & Chr$(34)
                    End If
                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, i + 1 + k)
                    swTable.Text(i + 1 + k, 2) = " "
                    If mElectro = 2 Then
                        swTable.Text(i + 1 + k, 4) = "Устанавливают по " & strTemp & "МЭ"
                    ElseIf mElectro = 3 Then
                        swTable.Text(i + 1 + k, 4) = "Устанавливают по " & strTemp & "ТБ"
                    Else
                        swTable.Text(i + 1 + k, 4) = "Устанавливают при электромонтаже"
                    End If
                    ok = swTable.SetCellTextFormat(i + 1 + k, 4, False, swTextFormatUnd)
                    swTable.CellTextHorizontalJustification(i + 1 + k, 4) = swTextJustificationCenter
                    m = i + 1 + k
                    k = k + 1
                End If
                ok = swTable.InsertRow(swTableItemInsertPosition_Before, i + 1 + k)
                swTable.Text(i + 1 + k, 2) = " "
                If Left$(sSectionData(j), 3) = "ЭМ-" Then
                    swTable.Text(i + 1 + k, 4) = Right$(sSectionData(j), Len(sSectionData(j)) - 3)
                Else
                    swTable.Text(i + 1 + k, 4) = sSectionData(j)
                End If
                ok = swTable.SetCellTextFormat(i + 1 + k, 4, False, swTextFormatUnd)
                swTable.CellTextHorizontalJustification(i + 1 + k, 4) = swTextJustificationCenter
                k = k + 1
                Exit For
            End If
        Next i
    Next j

    nNumRow = swTable.RowCount
    ' Вставляем раздел Комплекты
    If mComplect = 1 Then ' Нужно вставить раздел Комплекты
        If m = 0 Then ' Определяем место вставки
            m = nNumRow
        End If
        ok = swTable.InsertRow(swTableItemInsertPosition_After, m - 1)
        swTable.Text(m, 2) = " "
        swTable.Text(m, 4) = "Комплекты"
        ok = swTable.SetCellTextFormat(m, 4, False, swTextFormatUnd)
        swTable.CellTextHorizontalJustification(m, 4) = swTextJustificationCenter
        If ComplectDataSize <> "-1" Then ' Есть документы
            For i = ComplectDataSize To 0 Step -1
                ok = swTable.InsertRow(swTableItemInsertPosition_After, m)
                ok = swTable.SetCellTextFormat(m + 1, 4, False, swTextFormat)
                swTable.CellTextHorizontalJustification(m + 1, 4) = swTextJustificationLeft
                swTable.Text(m + 1, 2) = " "
                For j = 0 To nNumColumn - 1
                    If j <> 2 Then
                        swTable.Text(m + 1, j) = ComplectData(i, j)
                    End If
                Next j
            Next i
        End If
    End If

    ' Раздел Документация
    If MSort = 0 Then ' Спецификации нет
        If ChkAssem.Value = False And UBound(DocData) = 0 And ChkADrw.Value = False Or ChkAssem.Value = False And UBound(DocData) <> 0 Or ChkAssem.Value = True And UBound(DocData) <> 0 Then
            ok = swTable.InsertRow(swTableItemInsertPosition_Before, 1)
            swTable.Text(1, 2) = " "
            swTable.Text(1, 4) = "Документация"
            ok = swTable.SetCellTextFormat(1, 4, False, swTextFormatUnd)
            swTable.CellTextHorizontalJustification(1, 4) = swTextJustificationCenter
            If sNumber = "1" Then ' Обозначение
                strTemp = sNumberText
                If sNumberText = sModelName Then
                    strTemp = "$PRPSHEET:" & Chr$(34) & "SW-File Name" & Chr$(34)
                End If
            Else
                strTemp = "$PRPSHEET:" & Chr$(34) & prpNumber & Chr$(34)
            End If
            If ChkAssem.Value = True Or ChkADrw.Value = True Then ' Исключаем Сборочный чертеж
                iTemp = 1
            Else
                iTemp = 0
            End If
            For i = UBound(DocData) To iTemp Step -1
                strTemp1 = Left$(DocData(i), InStr(DocData(i), "-") - 1)
                strTemp1 = Trim(strTemp1)
                strTemp2 = Right$(DocData(i), Len(DocData(i)) - InStr(DocData(i), "-"))
                strTemp2 = Trim(strTemp2)
                ok = swTable.InsertRow(swTableItemInsertPosition_Before, 2)
                ok = swTable.SetCellTextFormat(2, 4, False, swTextFormat)
                swTable.CellTextHorizontalJustification(2, 4) = swTextJustificationLeft
                swTable.Text(2, 2) = " "
                '!!!!!!!!!!!!!!' Формат
                If Left$(strTemp1, 1) = "+" Then
                    strTemp1 = Right$(strTemp1, Len(strTemp1) - 1)
                    swTable.Text(2, 3) = strTemp1 ' Обозначение
                Else
                    swTable.Text(2, 3) = strTemp & strTemp1 ' Обозначение
                End If
                swTable.Text(2, 4) = strTemp2 ' Наименование
                '!!!!!!!!!!!!!!' Примечание
                If CboType.ListIndex = 1 Then ' Групповая спецификация
                    For j = 0 To UBound(vConfVisible)
                        swTable.Text(2, 5 + j) = "X"
                    Next j
                End If
            Next i
        End If
    Else ' Спецификация есть
        If DocDataRealSize <> "-1" Then ' Есть отмеченные документы
            If ChkAssem.Value = False And DocDataRealSize = 0 And ChkADrw.Value = False Or ChkAssem.Value = False And DocDataRealSize <> 0 Or ChkAssem.Value = True And DocDataRealSize <> 0 Then
                ok = swTable.InsertRow(swTableItemInsertPosition_Before, 1)
                swTable.Text(1, 2) = " "
                swTable.Text(1, 4) = "Документация"
                ok = swTable.SetCellTextFormat(1, 4, False, swTextFormatUnd)
                swTable.CellTextHorizontalJustification(1, 4) = swTextJustificationCenter
                If ChkAssem.Value = True Or ChkADrw.Value = True Then  ' Исключаем Сборочный чертеж
                    iTemp = 1
                Else
                    iTemp = 0
                End If
                For i = DocDataRealSize To iTemp Step -1
                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, 2)
                    ok = swTable.SetCellTextFormat(2, 4, False, swTextFormat)
                    swTable.CellTextHorizontalJustification(2, 4) = swTextJustificationLeft
                    swTable.Text(2, 2) = " "
                    If CboType.ListIndex = 0 Then ' Спецификация
                        For j = 0 To nNumColumn - 1
                            swTable.Text(2, j) = DocDataReal(i, j)
                        Next j
                    ElseIf CboType.ListIndex = 1 Then ' Групповая спецификация
    '                    Debug.Print "vConfVisibleSP", UBound(vConfVisibleSP)
    '                    For j = 0 To UBound(vConfVisibleSP)
    '                        Debug.Print vConfVisibleSP(j)
    '                    Next j
    '                    Debug.Print "vConfVisible", UBound(vConfVisible)
    '                    For j = 0 To UBound(vConfVisible)
    '                        Debug.Print vConfVisible(j)
    '                    Next j
                        For j = 0 To 4
                            swTable.Text(2, j) = DocDataReal(i, j)
                        Next j
                        For j = 5 To 14
                            If j > UBound(vConfVisible) + 5 Then
                                swTable.Text(2, j) = ""
                            Else
                                For jj = 0 To UBound(vConfVisibleSP)
                                    swTable.Text(2, j) = "X"
                                    If vConfVisible(j - 5) = vConfVisibleSP(jj) Then
                                        swTable.Text(2, j) = DocDataReal(i, 5 + jj)
                                        Exit For
                                    End If
                                Next jj
                            End If
                        Next j
                        swTable.Text(2, 15) = DocDataReal(i, 15)
                    Else ' Ведомость покупных
                    ' ***********
                    End If
                Next i
            End If
        End If
    End If
    If ChkAssem.Value = False Then
        swTable.Text(2, 0) = CboFormat.Value ' Формат для СБ
        swTable.Text(2, nNumColumn - 1) = TxtRemark.Value ' Примечание для СБ
    End If
Else ' Ведомость покупных
    ' Вставляем заголовки групп и дополнительные строки
    Set swTextFormat = swTable.GetCellTextFormat(1, 1)
    Set swTextFormatUnd = swTable.GetCellTextFormat(1, 1)
    swTextFormatUnd.Underline = True
    k = 0
    For j = 0 To UBound(sGroupData)
        For i = 0 To nNumRow - 2 ' (-1 т.к с 0, -1 т.к. пропускаем первую строку)
            'Debug.Print "Перед вставкой групп"
            'Debug.Print sSpecData(i, 1), sSpecData(i, nNumColumn +3)
            If sSpecData(i, nNumColumn + 3) = sGroupData(j) Then
                ok = swTable.InsertRow(swTableItemInsertPosition_Before, i + 1 + k)
                swTable.Text(i + 1 + k, 1) = sGroupData(j)
                ok = swTable.SetCellTextFormat(i + 1 + k, 1, False, swTextFormatUnd)
                swTable.CellTextHorizontalJustification(i + 1 + k, 1) = swTextJustificationCenter
                k = k + 1
                Exit For
            End If
        Next i
    Next j
    ' Удаление вылезших ранее удаленных строк
    nNumRowTemp = swTable.RowCount
    If nNumRowTemp > nNumRow + k Then
        For i = 1 To nNumRowTemp - nNumRow - k
            ok = swTable.DeleteRow(nNumRowTemp - i)
        Next i
    End If
End If

ImgInfo.Width = 280

SetFont ' Устанавливаем шрифт

ImgInfo.Width = 320

SpaceRow ' Пустые строки

ImgInfo.Width = 360

MFormat = 1
CmdFormat_Click ' Форматирование
MFormat = 0

ImgInfo.Width = 400

If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    MPosition = 1
        CmdPosition_Click ' Позиции
    MPosition = 0
    RView
End If

ImgInfo.Width = 447
LblInfo.Caption = " Готово"
Finish
End Sub

Private Sub Finish()
' Возвращение активного листа
ok = swDraw.ActivateSheet(strActiveSheetName)
swModelView.EnableGraphicsUpdate = True
swModelView.UpdateAllGraphicsLayers = True
Hide
Unload Me
End
End Sub

Private Sub CmdCancel_Click()
swDraw.ClearSelection2 True
Finish
End Sub

Private Sub SetFont()

LblInfo.Caption = " Применение шрифта"

' Устанавливаем шрифт
nNumRow = swTable.RowCount
nNumColumn = swTable.ColumnCount
Set swTextFormat = swTable.GetCellTextFormat(1, 4)
Debug.Print swTextFormat.BackWards, swTextFormat.Bold, swTextFormat.CharHeight
Debug.Print swTextFormat.CharHeightInPts, swTextFormat.CharSpacingFactor, swTextFormat.Escapement
Debug.Print swTextFormat.Italic, swTextFormat.LineLength, swTextFormat.LineSpacing
Debug.Print swTextFormat.ObliqueAngle, swTextFormat.Strikeout, swTextFormat.TypeFaceName
Debug.Print swTextFormat.Underline, swTextFormat.UpsideDown, swTextFormat.Vertical
Debug.Print swTextFormat.WidthFactor
Set swTextFormatUnd = swTable.GetCellTextFormat(1, 4)
swTextFormat.TypeFaceName = stdFontName
swTextFormatUnd.TypeFaceName = stdFontName
'swTextFormat.CharHeightInPts = Int(stdFontSize * 3.9) ' 3.891
swTextFormat.CharHeight = stdFontSize / 1000
swTextFormatUnd.CharHeight = stdFontSize / 1000
swTextFormat.LineSpacing = (8 - stdFontSize - 0.3) / 1000
swTextFormatUnd.LineSpacing = (8 - stdFontSize - 0.3) / 1000
swTextFormat.WidthFactor = dFontWidth
swTextFormatUnd.WidthFactor = dFontWidth
'swTextFormatUnd.Escapement = 1.57
'swTextFormatUnd.ObliqueAngle = 1.57
If stdFontItalic = 1 Then
    swTextFormat.Italic = True
    swTextFormatUnd.Italic = True
Else
    swTextFormat.Italic = False
    swTextFormatUnd.Italic = False
End If
If stdFontBold = 1 Then
    swTextFormat.Bold = True
    swTextFormatUnd.Bold = True
Else
    swTextFormat.Bold = False
    swTextFormatUnd.Bold = False
End If
swTextFormat.Underline = False
swTextFormatUnd.Underline = True
For i = 1 To nNumRow - 1
    For j = 0 To nNumColumn - 1
        Set swTextFormatTest = swTable.GetCellTextFormat(i, j)
        If swTextFormatTest.Underline Then ' Заголовок
            ok = swTable.SetCellTextFormat(i, j, False, swTextFormatUnd)
            swTable.CellTextHorizontalJustification(i, j) = swTextJustificationCenter
        Else
            ok = swTable.SetCellTextFormat(i, j, False, swTextFormat)
            If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                If j = 3 Or j = 4 Or j = nNumColumn - 1 Then
                    swTable.CellTextHorizontalJustification(i, j) = swTextJustificationLeft
                Else
                    swTable.CellTextHorizontalJustification(i, j) = swTextJustificationCenter
                End If
            Else ' Ведомость покупных
                If j = 1 Or j = 2 Or j = 3 Or j = 4 Or j = 5 Or j = nNumColumn - 1 Then
                    swTable.CellTextHorizontalJustification(i, j) = swTextJustificationLeft
                Else
                    swTable.CellTextHorizontalJustification(i, j) = swTextJustificationCenter
                End If
            End If
        End If
        swTable.CellTextVerticalJustification(i, j) = swTextAlignmentTop
    Next j
    'ok = swTable.SetRowVerticalGap(i, 0.03 / 1000)
Next i
If ChkAssem.Value = True Then ' Устанавливаем шрифт шапки для специи на листе СБ
    For i = 0 To 6
        Set swTextFormat = swTable.GetCellTextFormat(0, i)
        swTextFormat.TypeFaceName = stdFontName
        'Debug.Print swTextFormat.Vertical, swTextFormat.Escapement, swTextFormat.ObliqueAngle
        'swTextFormat.Escapement = 1.57
        'swTextFormat.ObliqueAngle = 90
        'swTextFormat.Vertical = True
        If stdFontItalic = 1 Then
            swTextFormat.Italic = True
        Else
            swTextFormat.Italic = False
        End If
        If stdFontBold = 1 Then
            swTextFormat.Bold = True
        Else
            swTextFormat.Bold = False
        End If
        ok = swTable.SetCellTextFormat(0, i, False, swTextFormat)
    Next i
End If
End Sub

Private Sub SpaceRow() ' Пустые строки

LblInfo.Caption = " Добавление пустых строк"

If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    Set swTextFormat = swTable.GetCellTextFormat(2, 4)
Else ' Ведомость покупных
    Set swTextFormat = swTable.GetCellTextFormat(2, 1)
End If

' Добавляем основные пустые строки
i = 1 ' Счетчик строк
k = 1 ' Метка конца таблицы
While k = 1
    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
        If swTable.Text(i, 4) <> "" Then
            Set swTextFormatTest = swTable.GetCellTextFormat(i, 4)
            If swTextFormatTest.Underline Then ' Заголовок
                If InStr(swTable.Text(i, 4), "Устанавливают") > 0 Then ' Найден раздел электромонтаж
                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, i)
                    ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
                    swTable.CellTextHorizontalJustification(i, 4) = swTextJustificationLeft
                    swTable.Text(i, 2) = " "
                    i = i + 1
                Else
                    ok = swTable.InsertRow(swTableItemInsertPosition_After, i)
                    ok = swTable.SetCellTextFormat(i + 1, 4, False, swTextFormat)
                    swTable.CellTextHorizontalJustification(i + 1, 4) = swTextJustificationLeft
                    swTable.Text(i + 1, 2) = " "
                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, i)
                    ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
                    swTable.CellTextHorizontalJustification(i, 4) = swTextJustificationLeft
                    swTable.Text(i, 2) = " "
                    i = i + 2
                End If
            End If
        End If
    Else ' Ведомость покупных
        If swTable.Text(i, 1) <> "" Then
            Set swTextFormatTest = swTable.GetCellTextFormat(i, 1)
            If swTextFormatTest.Underline Then ' Заголовок
                ok = swTable.InsertRow(swTableItemInsertPosition_After, i)
                ok = swTable.SetCellTextFormat(i + 1, 1, False, swTextFormat)
                swTable.CellTextHorizontalJustification(i + 1, 1) = swTextJustificationLeft
                ok = swTable.InsertRow(swTableItemInsertPosition_Before, i)
                ok = swTable.SetCellTextFormat(i, 1, False, swTextFormat)
                swTable.CellTextHorizontalJustification(i, 1) = swTextJustificationLeft
                i = i + 2
            End If
        End If
    End If
    i = i + 1
    nNumRow = swTable.RowCount
    If i > nNumRow - 1 Then
        k = 0
    End If
Wend

' Добавляем резервированные строки
If iLine = 1 Then ' Добавляем строки после каждой строки
    i = 1 ' Счетчик строк
    k = 1 ' Метка конца таблицы
    While k = 1
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            If swTable.Text(i, 3) <> "" Or swTable.Text(i, 4) <> "" Then
                Set swTextFormatTest = swTable.GetCellTextFormat(i, 4)
                If swTextFormatTest.Underline Then ' Заголовок
                Else
                    For j = 1 To iLineCount
                        ok = swTable.InsertRow(swTableItemInsertPosition_After, i)
                        swTable.Text(i + 1, 2) = " "
                        i = i + 1
                    Next j
                End If
            End If
        Else ' Ведомость покупных
            If swTable.Text(i, 1) <> "" Then
                Set swTextFormatTest = swTable.GetCellTextFormat(i, 1)
                If swTextFormatTest.Underline Then ' Заголовок
                Else
                    For j = 1 To iLineCount
                        ok = swTable.InsertRow(swTableItemInsertPosition_After, i)
                        i = i + 1
                    Next j
                End If
            End If
        End If
        i = i + 1
        nNumRow = swTable.RowCount
        If i > nNumRow - 1 Then
            k = 0
        End If
    Wend
    nNumRow = swTable.RowCount
    For j = 1 To iLineCount ' Удаляем лишнее
        ok = swTable.DeleteRow(nNumRow - j)
    Next j
End If
If iSection = 1 Then ' Добавляем строки после каждого раздела
    i = 1 ' Счетчик строк
    k = 1 ' Метка конца таблицы
    m = 0
    While k = 1
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            If swTable.Text(i, 4) <> "" Then
                Set swTextFormatTest = swTable.GetCellTextFormat(i, 4)
                If swTextFormatTest.Underline Then ' Заголовок
                    If m = 1 Then
                        For j = 1 To iSectionCount
                            ok = swTable.InsertRow(swTableItemInsertPosition_Before, i)
                            swTable.Text(i, 2) = " "
                            i = i + 1
                        Next j
                    End If
                    m = 1
                End If
            End If
        Else ' Ведомость покупных
            If swTable.Text(i, 1) <> "" Then
                Set swTextFormatTest = swTable.GetCellTextFormat(i, 1)
                If swTextFormatTest.Underline Then ' Заголовок
                    If m = 1 Then
                        For j = 1 To iSectionCount
                            ok = swTable.InsertRow(swTableItemInsertPosition_Before, i)
                            i = i + 1
                        Next j
                    End If
                    m = 1
                End If
            End If
        End If
        i = i + 1
        nNumRow = swTable.RowCount - 1
        If i > nNumRow - 1 Then
            k = 0
        End If
    Wend
End If

' Добавляем пустые строки в конец таблицы
nNumRow = swTable.RowCount
If mBlankRow = 1 Then
    For i = 0 To CInt(strBlankRow) - 1
        ok = swTable.InsertRow(swTableItemInsertPosition_After, nNumRow - 1)
        swTable.Text(nNumRow, 2) = " "
    Next i
End If

End Sub

Private Sub CmdFormat_Click() ' Форматирование

If MFormat = 0 Then
    ImgInfo.Width = 5
    Prepare ' Подготовка таблицы
    DeleteSpaceRow ' Удаление пустых строк
    ImgInfo.Width = 110
    SetFont ' Устанавливаем шрифт
    SpaceRow ' Пустые строки
    ImgInfo.Width = 220
    MSort = 1
End If

LblInfo.Caption = " Форматирование"

' Форматируем
' Столбцы
nNumRow = swTable.RowCount
nNumColumn = swTable.ColumnCount

' Затираем заголовки столбцов
If ChkAssem.Value = False Then
    For i = 0 To nNumColumn - 1
        ok = swTable.SetColumnTitle(i, " ")
    Next i
Else
End If

If CboType.ListIndex = 0 Then ' Спецификация
    dRetval = swTable.SetColumnWidth(0, 0.006, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(1, 0.006, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(2, 0.008, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(3, 0.07, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(4, 0.063, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(5, 0.01, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(6, 0.022, swTableRowColChange_TableSizeCanChange)
ElseIf CboType.ListIndex = 1 Then ' Групповая спецификация
    dRetval = swTable.SetColumnWidth(0, 0.006, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(1, 0.006, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(2, 0.008, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(3, 0.07, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(4, 0.063, swTableRowColChange_TableSizeCanChange)
    For i = 5 To nNumColumn - 2
        dRetval = swTable.SetColumnWidth(i, 0.01, swTableRowColChange_TableSizeCanChange)
    Next i
    dRetval = swTable.SetColumnWidth(nNumColumn - 1, 0.034, swTableRowColChange_TableSizeCanChange)
    ok = swTable.MergeCells(0, 5, 0, 14)
Else ' Ведомость покупных
    dRetval = swTable.SetColumnWidth(0, 0.007, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(1, 0.06, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(2, 0.045, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(3, 0.07, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(4, 0.055, swTableRowColChange_TableSizeCanChange)
    dRetval = swTable.SetColumnWidth(5, 0.07, swTableRowColChange_TableSizeCanChange)
    For i = 6 To 9
        dRetval = swTable.SetColumnWidth(i, 0.016, swTableRowColChange_TableSizeCanChange)
    Next i
    dRetval = swTable.SetColumnWidth(10, 0.024, swTableRowColChange_TableSizeCanChange)
    ok = swTable.MergeCells(0, 6, 0, 9)
End If
' Строки
If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    dRetval = swTable.SetRowHeight(0, 0.015, swTableRowColChange_TableSizeCanChange)
Else ' Ведомость покупных
    dRetval = swTable.SetRowHeight(0, 0.027, swTableRowColChange_TableSizeCanChange)
End If
For i = 1 To nNumRow - 1
    ' Поджимаем стобец Формат
    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
        Set swTextFormat = swTable.GetCellTextFormat(1, 0)
        swTextFormat.WidthFactor = dFontWidth / 1.4
        ok = swTable.SetCellTextFormat(i, 0, False, swTextFormat)
    End If
    ' Общее сжатие и столбец Примечание
    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
        Set swTextFormat = swTable.GetCellTextFormat(i, 4)
        swTextFormat.WidthFactor = dFontWidth
        ok = swTable.SetCellTextFormat(i, 3, False, swTextFormat)
        ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
        swTextFormat.WidthFactor = dFontWidth * dRemarkWidth
        ok = swTable.SetCellTextFormat(i, nNumColumn - 1, False, swTextFormat)
        Set swTextFormat = swTable.GetCellTextFormat(i, 1)
        swTextFormat.WidthFactor = dFontWidth
        ok = swTable.SetCellTextFormat(i, 1, False, swTextFormat)
        ok = swTable.SetCellTextFormat(i, 2, False, swTextFormat)
        For j = 5 To nNumColumn - 2
            ok = swTable.SetCellTextFormat(i, j, False, swTextFormat)
        Next j
    Else ' Ведомость покупных
        Set swTextFormat = swTable.GetCellTextFormat(i, 1)
        swTextFormat.WidthFactor = dFontWidth
        ok = swTable.SetCellTextFormat(i, 1, False, swTextFormat)
        ok = swTable.SetCellTextFormat(i, 2, False, swTextFormat)
        ok = swTable.SetCellTextFormat(i, 3, False, swTextFormat)
        ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
        ok = swTable.SetCellTextFormat(i, 5, False, swTextFormat)
        swTextFormat.WidthFactor = dFontWidth * dRemarkWidth
        ok = swTable.SetCellTextFormat(i, nNumColumn - 1, False, swTextFormat)
        Set swTextFormat = swTable.GetCellTextFormat(i, 6)
        swTextFormat.WidthFactor = dFontWidth
        For j = 6 To nNumColumn - 2
            ok = swTable.SetCellTextFormat(i, j, False, swTextFormat)
        Next j
    End If
    ' Поджимаем длинные строки
    k1 = 0 ' число добавленных строк по высоте
    dRetval = swTable.SetRowHeight(i, 0.008, swTableRowColChange_TableSizeCanChange)
    If dRetval > 0.008 Then ' Поджимаем текст
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            Set swTextFormat = swTable.GetCellTextFormat(i, 4)
            swTextFormat.WidthFactor = dFontWidth * dRowWidth
            ok = swTable.SetCellTextFormat(i, 3, False, swTextFormat)
            ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
            swTextFormat.WidthFactor = dFontWidth * dRowWidth * dRemarkWidth
            ok = swTable.SetCellTextFormat(i, nNumColumn - 1, False, swTextFormat)
        Else ' Ведомость покупных
            Set swTextFormat = swTable.GetCellTextFormat(i, 1)
            swTextFormat.WidthFactor = dFontWidth * dRowWidth
            ok = swTable.SetCellTextFormat(i, 1, False, swTextFormat)
            ok = swTable.SetCellTextFormat(i, 2, False, swTextFormat)
            ok = swTable.SetCellTextFormat(i, 3, False, swTextFormat)
            ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
            ok = swTable.SetCellTextFormat(i, 5, False, swTextFormat)
            swTextFormat.WidthFactor = dFontWidth * dRowWidth * dRemarkWidth
            ok = swTable.SetCellTextFormat(i, nNumColumn - 1, False, swTextFormat)
        End If
        dRetval = swTable.SetRowHeight(i, 0.008, swTableRowColChange_TableSizeCanChange)
        If dRetval > 0.008 Then ' Увеличиваем высоту строки
            swTextFormat.CharHeight = stdFontSize / 1000
            swTextFormat.LineSpacing = (8 - stdFontSize - 0.1) / 1000
            swTextFormat.WidthFactor = dFontWidth * dRowWidth
            If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                ok = swTable.SetCellTextFormat(i, 3, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, 3) = swTextAlignmentTop
                ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, 4) = swTextAlignmentTop
                swTextFormat.WidthFactor = dFontWidth * dRowWidth * dRemarkWidth
                ok = swTable.SetCellTextFormat(i, nNumColumn - 1, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, nNumColumn - 1) = swTextAlignmentTop
            Else ' Ведомость покупных
                ok = swTable.SetCellTextFormat(i, 1, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, 1) = swTextAlignmentTop
                ok = swTable.SetCellTextFormat(i, 2, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, 2) = swTextAlignmentTop
                ok = swTable.SetCellTextFormat(i, 3, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, 3) = swTextAlignmentTop
                ok = swTable.SetCellTextFormat(i, 4, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, 4) = swTextAlignmentTop
                ok = swTable.SetCellTextFormat(i, 5, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, 5) = swTextAlignmentTop
                swTextFormat.WidthFactor = dFontWidth * dRowWidth * dRemarkWidth
                ok = swTable.SetCellTextFormat(i, nNumColumn - 1, False, swTextFormat)
                swTable.CellTextVerticalJustification(i, nNumColumn - 1) = swTextAlignmentTop
            End If
            k1 = Round(dRetval / (7.7 / 1000)) - 1  ' Определяем число дополнительных строк
            dblTemp = k1 * 0.008 + 0.008
            dRetval = swTable.SetRowHeight(i, dblTemp, swTableRowColChange_TableSizeCanChange)
        End If
    End If
Next i

' Перенос раздела Электромонтаж на новый лист для первого листа
If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    nNumRow = swTable.RowCount
    dblTemp = 0#
    k3 = 0 ' Номер строки электромонтаж
    m = 0 ' Метка обработки электромонтажа
    For i = 1 To nNumRow - 1 ' Проверяем электромонтаж
        dblTemp = dblTemp + swTable.GetRowHeight(i)
        strTemp = swTable.Text(i, 4)
        Set swTextFormatTest = swTable.GetCellTextFormat(i, 4)
        If InStr(strTemp, "Устанавливают") > 0 And swTextFormatTest.Underline Then ' Найден раздел электромонтаж
            k3 = i
            l = Int(((dblTemp - CDbl(nFirst) * 0.008) / (CDbl(nSecond) * 0.008)) + 1.99) ' Номер листа на котором есть раздел электромонтаж
            dblTemp = nFirst * 0.008 + nSecond * (l - 1) * 0.008 - dblTemp + swTable.GetRowHeight(k3)
            l1 = CInt(dblTemp / 0.008) ' Число строк, которое нужно добавить перед заголовком электромонтаж
            If l = 1 Then ' Если электромонтаж найден на первом листе
                For jj = 1 To l1  ' Двигаем заголовок электромонтаж
                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, k3)
                    swTable.Text(k3, 2) = " "
                    dRetval = swTable.SetRowHeight(k3, 0.008, swTableRowColChange_TableSizeCanChange)
                Next jj
                m = 1
            End If
            Exit For
        End If
    Next i
End If

' Добавляем строки для корректного переноса
nNumRow = swTable.RowCount
nNumColumn = swTable.ColumnCount
dblTemp = 0#
For i = 1 To nNumRow - 1 ' Вычисляем общую высоту таблицы
    dblTemp = dblTemp + swTable.GetRowHeight(i)
Next i
k = 1 ' Метка конца таблицы
n = nFirst
i = 0 ' Счетчик листов
If dblTemp > nFirst * 0.008 + 0.001 Then ' Если не помещаемся на одном листе
    While k = 1
        k = 0 ' Метка конца таблицы
        k1 = 0 ' Счетчик строк, добавляемых для переноса широких строк
        k2 = 0 ' Счетчик строк, добавляемых для переноса подвисших заголовков
        ' Проверяем многострочные записи
        dblTemp = 0#
        j = 0 ' Счетчик строк
        While dblTemp + 0.001 < n * 0.008 ' Определяем количество строк до границы листов
            j = j + 1
            dblTemp = dblTemp + swTable.GetRowHeight(j)
        Wend
        If dblTemp > n * 0.008 + 0.001 Then ' Определяем, есть ли высокая строка на границе и количество добавляемых строк
            dblTemp = dblTemp - n * 0.008
            dblTemp = swTable.GetRowHeight(j) - dblTemp
            k1 = CInt(dblTemp / 0.008)
        End If
        For jj = 1 To k1 ' Добавляем строки
            ok = swTable.InsertRow(swTableItemInsertPosition_Before, j)
            swTable.Text(j, 2) = " "
            dRetval = swTable.SetRowHeight(j, 0.008, swTableRowColChange_TableSizeCanChange)
        Next jj
        ' Боремся с подвисшими заголовками
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            jjj = 4
        Else ' Ведомость покупных
            jjj = 1
        End If
        If k1 > 0 Then ' Определяем шаг для выбра строки
            j1 = 1
        Else
            j1 = 0
        End If
        Set swTextFormat = swTable.GetCellTextFormat(j - j1, jjj) ' Проверяем ячейку в последней (если не было добавлений) строке страницы, если было то в предпоследней
        If swTextFormat.Underline Then  ' Добавляем строки
            k2 = CInt(swTable.GetRowHeight(j - j1) / 0.008) ' Определяем количество добавляемых строк
            For jj = 1 To k2 + k1 ' Добавляем строки
                ok = swTable.InsertRow(swTableItemInsertPosition_Before, j - j1)
                swTable.Text(j - j1, 2) = " "
                dRetval = swTable.SetRowHeight(j - j1, 0.008, swTableRowColChange_TableSizeCanChange)
            Next jj
            For jj = 1 To k1 ' Удаляем лишние строки
                ok = swTable.DeleteRow(j + 3)
            Next jj
        Else    ' Проверяем предпоследнюю строку страницы
            Set swTextFormat = swTable.GetCellTextFormat(j - 1 - j1, jjj) ' Проверяем ячейку в предпоследней (если не было добавлений) строке страницы, если было то в предпредпоследней
            If swTextFormat.Underline Then  ' Добавляем строки
                k2 = CInt(swTable.GetRowHeight(j - 1 - j1) / 0.008) + 1 ' Определяем количество добавляемых строк
                For jj = 1 To k2 + k1 ' Добавляем строки
                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, j - 1 - j1)
                    swTable.Text(j - 1 - j1, 2) = " "
                    dRetval = swTable.SetRowHeight(j - 1 - j1, 0.008, swTableRowColChange_TableSizeCanChange)
                Next jj
                For jj = 1 To k1 ' Удаляем лишние строки
                    ok = swTable.DeleteRow(j + 3)
                Next jj
            End If
        End If

        ' Перенос раздела Электромонтаж на новый лист
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            If m = 0 And k3 <> 0 Then ' Найден раздел электромонтаж и он еще не обрабатывался
                dblTemp = 0#
                j1 = 0 ' Счетчик строк последней страницы в цикле
                m1 = 0 ' Метка строк с текстом на последней странице, чтобы не получилось пустой страницы перед электромонтажем
                For jjj = 1 To nNumRow - 1
                    dblTemp = dblTemp + swTable.GetRowHeight(jjj)
                    If dblTemp > n * 0.008 + 0.001 And dblTemp <= (n + nSecond) * 0.008 Then
                        strTemp = swTable.Text(jjj, 4)
                        Set swTextFormatTest = swTable.GetCellTextFormat(jjj, 4)
                        If InStr(strTemp, "Устанавливают") > 0 And swTextFormatTest.Underline Then ' Найден раздел электромонтаж
                            k3 = jjj
                            'l = Int(((dblTemp - CDbl(nFirst) * 0.008) / (CDbl(nSecond) * 0.008)) + 1.99) ' Номер листа на котором есть раздел электромонтаж
                            'l = i + 1
                            'dblTemp = nFirst * 0.008 + nSecond * (l - 1) * 0.008 - dblTemp + swTable.GetRowHeight(k3)
                            dblTemp = (n + nSecond) * 0.008 - dblTemp + swTable.GetRowHeight(k3)
                            l1 = CInt(dblTemp / 0.008) ' Число строк, которое нужно добавить перед заголовком электромонтаж
                            ' Проверяем предыдущие строки на пустоту
                            If m1 <> 0 Then ' Найдены строки с текстом
                                For jj = 1 To l1  ' Двигаем заголовок электромонтаж
                                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, k3)
                                    swTable.Text(k3, 2) = " "
                                    dRetval = swTable.SetRowHeight(k3, 0.008, swTableRowColChange_TableSizeCanChange)
                                Next jj
                            Else
                                If j1 = 0 Then ' Строчка электромонтаж первая на странице
                                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, k3)
                                    swTable.Text(k3, 2) = " "
                                    dRetval = swTable.SetRowHeight(k3, 0.008, swTableRowColChange_TableSizeCanChange)
                                Else ' Удаляем лишние пустые строки
                                    For jj = 1 To j1 - 1 ' Двигаем заголовок электромонтаж
                                        ok = swTable.DeleteRow(k3 - jj)
                                    Next jj
                                End If
                            End If
                            m = 1
                            Exit For
                        End If
                        j1 = j1 + 1
                        For jj = 0 To nNumColumn - 1
                            If swTable.Text(jjj, jj) = "" Or swTable.Text(jjj, jj) = " " Then
                            Else
                                m1 = 1 ' Найдены строки с текстом
                            End If
                        Next jj
                    End If
                Next jjj
            End If
        End If

        ' Вычисляем общую высоту таблицы
        nNumRow = swTable.RowCount
        dblTemp = 0#
        For jj = 1 To nNumRow - 1
            dblTemp = dblTemp + swTable.GetRowHeight(jj)
        Next jj
        i = i + 1
        If dblTemp > (nFirst + i * nSecond) * 0.008 + 0.001 Then ' Работаем со следующим листом
            k = 1
            n = nFirst + i * nSecond
        End If
     Wend
End If

' Форматируем строки еще раз
'nNumRow = swTable.RowCount
'For i = 1 To nNumRow - 1
'    dRetval = swTable.SetRowHeight(i, 0.008, swTableRowColChange_TableSizeCanChange)
'Next i

' Добавляем уравнение для ВП
If CboType.ListIndex = 2 Then
    nNumRow = swTable.RowCount
    For i = 1 To nNumRow - 1
        If swTable.Text(i, 6) = "" Then
            swTable.Text(i, 9) = ""
        Else
            n = 0
            For j = 6 To 8
                If IsNumeric(swTable.Text(i, j)) = True Then
                    n = n + CInt(swTable.Text(i, j))
                End If
            Next j
            If n = 0 Then
                swTable.Text(i, 9) = ""
            Else
                swTable.Text(i, 9) = n ' "=SUM(G" & i + 1 & ":I" & i + 1 & ")"
            End If
        End If
    Next i
End If

'If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
'    MPosition = 1
'    CmdPosition_Click ' Позиции
'    MPosition = 0
'End If

If MFormat = 0 Then
    ImgInfo.Width = 330
End If

Sheets ' Разделение на листы

If MFormat = 0 Then
    ImgInfo.Width = 447
    LblInfo.Caption = " Готово"
    Finish
End If

End Sub

Private Sub CmdPosition_Click() ' Расстановка позиций

If MPosition = 0 Then
    ImgInfo.Width = 5
End If
LblInfo.Caption = " Расстановка позиций"

nNumRow = swTable.RowCount
Debug.Print "nNumRow=", nNumRow
j = 0 ' Счетчик номеров позиций
ii = 1 ' Счетчик строк с позициями
jj = 1 ' Счетчик исполнений
jjj = 0 ' Счетчик пустых строк
m = 0 ' Метка обнаружения заголовка раздела
n = 0 ' Метка прохождения первого раздела
m1 = 0
For i = 1 To nNumRow - 1
    If iPosReserve = 1 Then ' Ищем пустые строки
        If swTable.Text(i, 0) = " " And swTable.Text(i, 2) = " " Then
            jjj = jjj + 1
        End If
    End If
    If iPosSection = 1 Then
        If swTable.Text(i, 4) <> "" Then
            Set swTextFormat = swTable.GetCellTextFormat(i, 4)
            If swTextFormat.Underline Then  ' Заголовок
                m = 1
            End If
        End If
    End If
    If swTable.Text(i, 2) <> " " Then
        Debug.Print swTable.Text(i, 3)
        If swTable.Text(i, 2) <> "-" Then
            If swTable.Text(i, 3) <> "" Or swTable.Text(i, 4) <> "" Then
                If CboType.ListIndex = 1 Then  ' Групповая спецификация
                    ReDim Preserve iTempArr(ii)
                    iTempArr(ii) = i
                    If ii <> 1 Then ' Проверяем необходимые повторы позиций
                        varTemp = InStr(swTable.Text(iTempArr(ii), 3), "-")
                        If varTemp > 0 Then ' Есть исполнение
                            Debug.Print Left$(swTable.Text(iTempArr(ii), 3), 1)
                            If Left$(swTable.Text(iTempArr(ii), 3), 1) = "-" Then ' Есть укороченное обозначение
                                m1 = 1
                            Else ' Сравниваем с базовой частью обозначения
                                Debug.Print Left$(swTable.Text(iTempArr(ii), 3), varTemp - 1), swTable.Text(iTempArr(ii - jj), 3)
                                If Left$(swTable.Text(iTempArr(ii), 3), varTemp - 1) = Left$(swTable.Text(iTempArr(ii - jj), 3), varTemp - 1) Then
                                    m1 = 1
                                End If
                            End If
                            If m1 = 1 Then ' Проверяем в каких исполнениях сборки присутствует
                                For j1 = 5 To 14
                                    If swTable.Text(iTempArr(ii), j1) <> "" And swTable.Text(iTempArr(ii - jj), j1) <> "" Then
                                        m1 = 0
                                        Exit For
                                    End If
                                Next j1
                            'Else
                            '    jj = 1
                            End If
                        'Else
                        '    jj = 1
                        End If
                    End If
                    If m1 = 1 Then
                        jj = jj + 1
                    Else
                        jj = 1
                    End If
                    ii = ii + 1
                End If
                If m1 = 0 Then
                    If iPosReserve = 1 Then
                        If n = 0 Then
                            jjj = 0
                        End If
                        j = j + jjj
                        n = 1
                    Else
                        If m = 1 And n = 1 Then ' В конце раздела
                            j = j + iPosSectionCount
                        End If
                        m = 0
                        n = 1
                        If iPosLine = 1 And j > 0 Then ' После каждой строки
                            j = j + iPosLineCount
                        End If
                    End If
                    j = j + 1
                    swTable.Text(i, 2) = j
                    'swTable.Text(i, 2) = CStr(j)
                    'swTable.Text(i, 2) = Str$(j)
                    'Debug.Print swTable.Text(i, 2), Trim(CStr(j))
                Else
                    swTable.Text(i, 2) = j
                    'swTable.Text(i, 2) = Str$(j)
                    'Debug.Print swTable.Text(i, 2), Trim(CStr(j))
                End If
                m1 = 0
                jjj = 0
            Else
                swTable.Text(i, 2) = " "
                jjj = jjj + 1
            End If
        Else
            jjj = 0
        End If
    End If
Next i

If MPosition = 0 Then
    swDraw.ForceRebuild3 (True)
End If

If MPosition = 0 Then
    ImgInfo.Width = 447
    LblInfo.Caption = " Готово"
    Finish
End If
End Sub

Private Sub Sheets() ' Разделение на листы

OpenClipboard (0&)
EmptyClipboard
CloseClipboard

' Отображаем таблицу
Set swAnn = swTable.GetAnnotation
swAnn.Visible = swAnnotationVisible

LblInfo.Caption = " Разделение на листы"

If ChkAssem.Value = False Then
    ' Определяем количество листов и указываем его на первом листе
    nNumRow = swTable.RowCount
    dblTemp = 0
    For i = 1 To nNumRow - 1 ' Вычисляем общую высоту таблицы
        dblTemp = dblTemp + swTable.GetRowHeight(i)
    Next i
    If dblTemp - 0.001 > nFirst * 0.008 Then ' Если не помещаемся на одном листе
        iSheetNumb = Int(((dblTemp - CDbl(nFirst) * 0.008) / (CDbl(nSecond) * 0.008)) + 1.99) ' Число листов спецификации
    Else
        iSheetNumb = 1
    End If
    Debug.Print "iSheetNumb=", iSheetNumb
    ' Заполняем заметки
    strSheetFormatName = swSheet.GetSheetFormatName()
    strTemp = "Sheet1@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        If iSheetNumb > 1 Then ' Листов больше одного
            strTemp = "1"
        Else
            strTemp = " "
        End If
        Set swNote = swSelMgr.GetSelectedObject2(1)
        swNote.SetText strTemp
    End If
    strTemp = "Sheet2@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        If iSheetNumb > 2 And iLRI = 1 Then
            swNote.SetText iSheetNumb + 1
        Else
            swNote.SetText iSheetNumb
        End If
    End If
    strTemp = "Revision2@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        swNote.SetText sRevision2
    End If
    strTemp = "Revision3@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        swNote.SetText sRevision3
    End If
    strTemp = "Revision4@" & strSheetFormatName
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        swNote.SetText sRevision4
    End If
    strTemp = "Date@" & strSheetFormatName
    Debug.Print "Date", sDate
    ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
    If ok = True Then
        Set swNote = swSelMgr.GetSelectedObject2(1)
        swNote.SetText sDate
    End If
    ' Скрываем/Отображаем исполнения, код и литеру для групповой спецификации
    If CboType.ListIndex = 1 Then ' Групповая спецификация
        j = 0
        For i = 0 To LstConfig.ListCount - 1
        If LstConfig.Selected(i) = True Then
            ReDim Preserve sTemp(j)
            sTemp(j) = vConfNameArr(i)
            j = j + 1
        End If
        Next i
        vConfVisible = sTemp
        For i = 0 To 9
            ' Исполнение
            strTemp = "Conf_0" & i & "@" & strSheetFormatName
            ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
            If ok = True Then
                Set swNote = swSelMgr.GetSelectedObject2(1)
                Set swAnn = swNote.GetAnnotation
                If i > UBound(vConfVisible) Then
                    swAnn.Visible = swAnnotationHidden
                Else
                    swAnn.Visible = swAnnotationVisible
                End If
            End If
            ' Код
            strTemp = "Code0" & i & "@" & strSheetFormatName
            ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
            If ok = True Then
                Set swNote = swSelMgr.GetSelectedObject2(1)
                If i > UBound(vConfVisible) Then
                    swNote.SetText " "
                Else
                    strTemp = swModel.CustomInfo2(vConfVisible(i), prpCode)
                    If strTemp = "" Then
                        swNote.SetText " "
                    Else
                        swNote.SetText strTemp
                    End If
                End If
            End If
            ' Литера
            strTemp = "Lit0" & i & "@" & strSheetFormatName
            ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
            If ok = True Then
                Set swNote = swSelMgr.GetSelectedObject2(1)
                If i > UBound(vConfVisible) Then
                    swNote.SetText " "
                Else
                    strTemp = swModel.CustomInfo2(vConfVisible(i), prpLit)
                    If strTemp = "" Then
                        swNote.SetText " "
                    Else
                        swNote.SetText strTemp
                    End If
                End If
            End If
        Next i
    End If
    swDraw.ClearSelection2 True

    'Разделение таблицы и перенос на другой лист или листы
    strActiveSheetName = swSheet.GetName
    If iSheetNumb > 1 Then
        n = nFirst
        For i = 1 To iSheetNumb - 1
            If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                strTemp = "SP" & LTrim(CStr(i + 1))
            Else ' Ведомость покупных
                strTemp = "VP" & LTrim(CStr(i + 1))
            End If
            m = 0
            For j = 0 To UBound(vSheetNames) ' Проверяем существование листа
                If vSheetNames(j) = strTemp Then
                    m = 1
                End If
            Next j
            Debug.Print "m=", m
            If m = 0 Then ' Листа не было
                ' Добавляем лист
                If CboType.ListIndex = 0 Then ' Спецификация
                    vRetval = swDraw.NewSheet3(strTemp, swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource3, 0.21, 0.297, "По умолчанию")
                ElseIf CboType.ListIndex = 1 Then ' Групповая спецификация
                    vRetval = swDraw.NewSheet3(strTemp, swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource7, 0.297, 0.21, "По умолчанию")
                Else ' Ведомость покупных
                    vRetval = swDraw.NewSheet3(strTemp, swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource13, 0.42, 0.297, "По умолчанию")
                End If
                Set swSheet = swDraw.GetCurrentSheet
                swSheet.SheetFormatVisible = True
                ' Вставляем вид
                Set swView = swDraw.CreateDrawViewFromModelView3(swModel.GetPathName, vModelViewNames(0), -0.1, 0, 0)
                swView.ReferencedConfiguration = sConfigName
                swDraw.SuppressView
                swDraw.ForceRebuild3 (True)
            Else ' Лист был
                ok = swDraw.ActivateSheet(strTemp)
                Set swSheet = swDraw.GetCurrentSheet
            End If

            ' Заполняем номер листа и инфу про изменение
            strSheetFormatName = swSheet.GetSheetFormatName()
            strTemp1 = "Sheet1@" & strSheetFormatName
            ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
            If ok = True Then
                Set swNote = swSelMgr.GetSelectedObject2(1)
                strTemp1 = LTrim(CStr(i + 1))
                swNote.SetText strTemp1
            End If
            strTemp1 = "Revision2@" & strSheetFormatName
            ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
            If ok = True Then
                Set swNote = swSelMgr.GetSelectedObject2(1)
                swNote.SetText sRevision2
            End If
            strTemp1 = "Revision3@" & strSheetFormatName
            ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
            If ok = True Then
                Set swNote = swSelMgr.GetSelectedObject2(1)
                swNote.SetText sRevision3
            End If
            strTemp1 = "Revision4@" & strSheetFormatName
            ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
            If ok = True Then
                Set swNote = swSelMgr.GetSelectedObject2(1)
                swNote.SetText sRevision4
            End If
            ' Скрываем/Отображаем исполнения для групповой спецификации
            If CboType.ListIndex = 1 Then ' Групповая спецификация
                For j = 0 To 9
                    strTemp1 = "Conf_0" & j & "@" & strSheetFormatName
                    ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
                    Set swNote = swSelMgr.GetSelectedObject2(1)
                    Set swAnn = swNote.GetAnnotation
                    If ok = True Then
                        If j > UBound(vConfVisible) Then
                            swAnn.Visible = swAnnotationHidden
                        Else
                            swAnn.Visible = swAnnotationVisible
                        End If
                    End If
                Next j
            End If
            swDraw.ClearSelection2 True

            ' Делим таблицу
            j = 0
            dblTemp = 0#
            While dblTemp + 0.001 < n * 0.008 ' Определяем количество строк на одном листе
                j = j + 1
                dblTemp = dblTemp + swTable.GetRowHeight(j)
            Wend
            Set swTable1 = swTable.Split(swTableSplit_BeforeRow, j + 1)
            swDraw.EditCut
            ok = swDraw.ActivateSheet(strTemp)
            swDraw.Paste
            swTable1.Anchored = True
            Set swTable = swTable1
            n = nFirst + i * nSecond
        Next i
    End If
    If iSheetNumb > 2 And iLRI = 1 Then ' Добавляем ЛРИ
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            strTemp = "SP_LRI"
        Else ' Ведомость покупных
            strTemp = "VP_LRI"
        End If
        m = 0
        For j = 0 To UBound(vSheetNames) ' Проверяем существование листа
            If vSheetNames(j) = strTemp Then
                m = 1
            End If
        Next j
        Debug.Print "m=", m
        If m = 0 Then ' Листа не было
            ' Добавляем лист
            If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
                vRetval = swDraw.NewSheet3(strTemp, swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource18, 0.21, 0.297, "По умолчанию")
            Else
                vRetval = swDraw.NewSheet3(strTemp, swDwgPapersUserDefined, swDwgTemplateCustom, 1#, 1#, True, sSource19, 0.21, 0.297, "По умолчанию")
            End If
            Set swSheet = swDraw.GetCurrentSheet
            swSheet.SheetFormatVisible = True
            ' Вставляем вид
            Set swView = swDraw.CreateDrawViewFromModelView3(swModel.GetPathName, vModelViewNames(0), -0.1, 0, 0)
            swView.ReferencedConfiguration = sConfigName
            swDraw.SuppressView
            swDraw.ForceRebuild3 (True)
        Else ' Лист был
            ok = swDraw.ActivateSheet(strTemp)
            Set swSheet = swDraw.GetCurrentSheet
        End If
        ' Заполняем номер листа и инфу про изменение
        strSheetFormatName = swSheet.GetSheetFormatName()
        strTemp1 = "Sheet1@" & strSheetFormatName
        ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
        If ok = True Then
            Set swNote = swSelMgr.GetSelectedObject2(1)
            strTemp1 = iSheetNumb + 1
            swNote.SetText strTemp1
        End If
        strTemp1 = "Revision2@" & strSheetFormatName
        ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
        If ok = True Then
            Set swNote = swSelMgr.GetSelectedObject2(1)
            swNote.SetText sRevision2
        End If
        strTemp1 = "Revision3@" & strSheetFormatName
        ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
        If ok = True Then
            Set swNote = swSelMgr.GetSelectedObject2(1)
            swNote.SetText sRevision3
        End If
        strTemp1 = "Revision4@" & strSheetFormatName
        ok = swDraw.Extension.SelectByID2(strTemp1, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
        If ok = True Then
            Set swNote = swSelMgr.GetSelectedObject2(1)
            swNote.SetText sRevision4
        End If
    End If
    If MSort = 1 Then
        ' Находим и удаляем лишние листы спецификации
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            strTemp = "SP"
        Else ' Ведомость покупных
            strTemp = "VP"
        End If
        For i = 0 To UBound(vSheetNames)
            ' Проверка имени листа
            m = 0
            If Left$(vSheetNames(i), 2) = strTemp Then
                If Mid$(vSheetNames(i), 3, 4) = "_LRI" Then
                    If iSheetNumb <= 2 Or iLRI = 0 Then
                        m = 1
                    End If
                Else
                    If CInt(Mid$(vSheetNames(i), 3, 1)) > iSheetNumb Then
                        m = 1
                    End If
                End If
            End If
            If m = 1 Then
                ok = swDraw.ActivateSheet(vSheetNames(i))
                Set swSheet = swDraw.GetCurrentSheet
                'DeleteOption = SwConst.swDelete_Absorbed + SwConst.swDelete_Children
                DeleteOption = 3
                ok = swDraw.Extension.SelectByID2(swSheet.GetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
                ok = swDraw.Extension.DeleteSelection2(DeleteOption)
            End If
        Next i
    End If

    ' Удаляем лишние листы
    If CboType.ListIndex = 2 Then  ' Ведомость покупных
        vSheetNames = swDraw.GetSheetNames
        For i = 0 To UBound(vSheetNames)
            If Left$(vSheetNames(i), 2) <> "VP" Then
                strTemp = "Удалить лист " & vSheetNames(i)
                lRetval = swApp.SendMsgToUser2(strTemp, swMbQuestion, swMbYesNo)
                If lRetval = swMbHitYes Then
                    ok = swDraw.ActivateSheet(vSheetNames(i))
                    Set swSheet = swDraw.GetCurrentSheet
                    'DeleteOption = SwConst.swDelete_Absorbed + SwConst.swDelete_Children
                    DeleteOption = 3
                    ok = swDraw.Extension.SelectByID2(swSheet.GetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
                    ok = swDraw.Extension.DeleteSelection2(DeleteOption)
                End If
            End If
        Next i
    End If
End If
swDraw.ClearSelection2 True
swDraw.ForceRebuild3 (True)
End Sub

Private Sub Sort() ' Модуль сортировки
Dim iCompare As Integer
Dim sSecond As String
Dim sFirst As String
Dim iResult1 As Integer
Dim iResult2 As Integer
Dim iResult3 As Integer
Dim iResult4 As Integer

Dim vFindFirst As Variant
Dim vFindSecond As Variant

Dim lPartLenFirst As Long
Dim lPartLenSecond As Long

Dim sPartFirst As String
Dim sPartSecond As String
Dim sPartFirst1 As String
Dim sPartSecond1 As String

Dim iPartFirst As Long
Dim iPartSecond As Long

Dim sStandardNameFirst As String
Dim sStandardNameSecond As String
Dim vStandardNameFirst As Variant
Dim vStandardNameSecond As Variant

Dim sStandardNumberFirst As String
Dim sStandardNumberSecond As String

Dim sNameFirst As String
Dim sNameSecond As String

Dim sNumFirst() As String
Dim sNumSecond() As String

Result = "S_ERROR"
Debug.Print "Sort "; sSpecData(i, 1) & " " & sSpecData(i, 3) & " и ", sSpecData(i + 1, 1) & " " & sSpecData(i + 1, 3)
Debug.Print "**********************"

iCompare = 0

If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
    sFirst = sSpecData(i, 4)  ' Поле Наименование
    sSecond = sSpecData(i + 1, 4) ' Поле Наименование
Else ' Ведомость покупных
    sFirst = sSpecData(i, 1) & " " & sSpecData(i, 3) ' Поле Наименование
    sSecond = sSpecData(i + 1, 1) & " " & sSpecData(i + 1, 3) ' Поле Наименование
End If
sFirst = Trim(sFirst)
sSecond = Trim(sSecond)

If sSpecData(i, nNumColumn - 5) = sSpecData(i + 1, nNumColumn - 5) Then  ' Строки из одного раздела
    If sSpecData(i, nNumColumn - 5) = "Стандартные изделия" Or sSpecData(i, nNumColumn - 5) = "Прочие изделия" Or sSpecData(i, nNumColumn - 5) = "Материалы" _
    Or sSpecData(i, nNumColumn - 5) = "ЭМ-Стандартные изделия" Or sSpecData(i, nNumColumn - 5) = "ЭМ-Прочие изделия" Or sSpecData(i, nNumColumn - 5) = "ЭМ-Материалы" Then ' Строка из разделов Стандартные изделия или Прочие изделия или Материалы
        If sFirst = "" Or sSecond = "" Then ' Если одна из строк пустая
            If sFirst = "" And sSecond <> "" Then
                Result = "S_GREAT"
            ElseIf sSecond = "" And sFirst <> "" Then
                Result = "S_LESS"
            Else
                Result = "S_EQUAL"
            End If
        Else
            If iOther = 0 And sSpecData(i, nNumColumn - 5) = "Прочие изделия" Or iOther = 0 And sSpecData(i, nNumColumn - 5) = "ЭМ-Прочие изделия" Then  ' Строка из раздела Прочие изделия
                m1 = UBound(sGroupData) + 1
                m2 = UBound(sGroupData) + 1
                For ii = 0 To UBound(sGroupData) ' Проверяем группу
                    If sSpecData(i, nNumColumn - 4) = sGroupData(ii) Then
                        m1 = ii
                    End If
                    If sSpecData(i + 1, nNumColumn - 4) = sGroupData(ii) Then
                        m2 = ii
                    End If
                Next ii
                If m1 > m2 Then
                    Result = "S_GREAT"
                ElseIf m1 < m2 Then
                    Result = "S_LESS"
                Else
                    iCompare = 1
                End If
            ElseIf sSpecData(i, nNumColumn - 5) = "Материалы" Or sSpecData(i, nNumColumn - 5) = "ЭМ-Материалы" Then  ' Строка из раздела Материалы
                m1 = UBound(sGroupData) + 1
                m2 = UBound(sGroupData) + 1
                For ii = 0 To UBound(sMaterialGroupData) ' Проверяем группу материала
                    If sSpecData(i, nNumColumn - 4) = sMaterialGroupData(ii) Then
                        m1 = ii
                    End If
                    If sSpecData(i + 1, nNumColumn - 4) = sMaterialGroupData(ii) Then
                        m2 = ii
                    End If
                Next ii
                If m1 > m2 Then
                    Result = "S_GREAT"
                ElseIf m1 < m2 Then
                    Result = "S_LESS"
                Else
                    iCompare = 1
                End If
            Else ' Строка из раздела Стандартные изделия
                m = 0
                If CboType.ListIndex = 2 Then ' Ведомость покупных
                    m1 = UBound(sGroupData) + 1
                    m2 = UBound(sGroupData) + 1
                    For ii = 0 To UBound(sGroupData) ' Проверяем группу
                        If sSpecData(i, nNumColumn - 4) = sGroupData(ii) Then
                            m1 = ii
                        End If
                        If sSpecData(i + 1, nNumColumn - 4) = sGroupData(ii) Then
                            m2 = ii
                        End If
                    Next ii
                    If m1 > m2 Then
                        Result = "S_GREAT"
                        m = 1
                    ElseIf m1 < m2 Then
                        Result = "S_LESS"
                        m = 1
                    End If
                End If
                If m = 0 Then
                    ' Заменяем перевод строки на пробел
                    sFirst = Replace(sFirst, Chr$(13) & Chr$(10), " ")
                    sFirst = Replace(sFirst, Chr$(10), " ")
                    sSecond = Replace(sSecond, Chr$(13) & Chr$(10), " ")
                    sSecond = Replace(sSecond, Chr$(10), " ")
                    ' Сравниваем типы стандартов
                    ReDim sTemp(11)
                    sTemp(0) = " ГОСТ "
                    sTemp(1) = " ISO "
                    sTemp(2) = " ГОСТ Р "
                    sTemp(3) = " ГОСТ Р ИСО "
                    sTemp(4) = " ANSI "
                    sTemp(5) = " ASME "
                    sTemp(6) = " ASTM "
                    sTemp(7) = " BSI "
                    sTemp(8) = " DIN "
                    sTemp(9) = " GB "
                    sTemp(10) = " JIS "
                    sTemp(11) = " ОСТ "
                    m1 = UBound(sTemp) + 1
                    m2 = UBound(sTemp) + 1
                    For ii = 0 To UBound(sTemp) ' Ищем тип стандарта
                        vFindFirst = InStrRev(sFirst, sTemp(ii))
                        If vFindFirst > 0 Then
                            vStandardNameFirst = InStrRev(sFirst, sTemp(ii))
                            m1 = ii
                            sStandardNameFirst = sTemp(ii)
                        End If
                    Next ii
                    For ii = 0 To UBound(sTemp) ' Ищем тип стандарта
                        vFindSecond = InStrRev(sSecond, sTemp(ii))
                        If vFindSecond > 0 Then
                            vStandardNameSecond = InStrRev(sSecond, sTemp(ii))
                            m2 = ii
                            sStandardNameSecond = sTemp(ii)
                        End If
                    Next ii
                    If m1 > m2 Then
                        Result = "S_GREAT"
                    ElseIf m1 < m2 Then
                        Result = "S_LESS"
                    ElseIf m1 = m2 And m1 = UBound(sTemp) + 1 Then ' Стандарт не найден в обеих строках
                        iCompare = 1
                    Else ' Стандарт найден в обеих строках
                        ' Сравниваем группы
                        m1 = UBound(sGroupData) + 1
                        m2 = UBound(sGroupData) + 1
                        For ii = 0 To UBound(sGroupData) ' Проверяем группу
                            If sSpecData(i, nNumColumn - 4) = sGroupData(ii) Then
                                m1 = ii
                            End If
                            If sSpecData(i + 1, nNumColumn - 4) = sGroupData(ii) Then
                                m2 = ii
                            End If
                        Next ii
                        If m1 > m2 Then
                            Result = "S_GREAT"
                        ElseIf m1 < m2 Then
                            Result = "S_LESS"
                        Else
                            ' Сравниваем типы изделий (Винт, Шайба ...)
                            sNameFirst = Left(sFirst, vStandardNameFirst - 1) ' Выделяем тип
                            sNameFirst = Trim(sNameFirst)
                            sNameSecond = Left(sSecond, vStandardNameSecond - 1) ' Выделяем тип
                            sNameSecond = Trim(sNameSecond)
                            If sNameFirst = "" Or sNameSecond = "" Then ' Если одна из строк пустая
                                iCompare = 1
                            Else
                                lPartLenFirst = Len(sNameFirst)
                                For ii = 1 To lPartLenFirst ' Ищем числовые части
                                    sPartFirst = Mid(sNameFirst, ii, 1)
                                    If IsNumeric(sPartFirst) = True Then  ' Если найденный символ число
                                        vFindFirst = InStrRev(sFirst, " ", ii) ' Находим первый пробел до числа
                                        If vFindFirst > 0 Then
                                            sNameFirst = Left(sFirst, vFindFirst - 1) ' Выделяем тип
                                            sNameFirst = Trim(sNameFirst)
                                        Else
                                            iCompare = 1
                                        End If
                                        Exit For
                                    End If
                                Next ii
                                lPartLenSecond = Len(sNameSecond)
                                For ii = 1 To lPartLenSecond ' Ищем числовые части
                                    sPartSecond = Mid(sNameSecond, ii, 1)
                                    If IsNumeric(sPartSecond) = True Then  ' Если найденный символ число
                                        vFindSecond = InStrRev(sSecond, " ", ii) ' Находим первый пробел до числа
                                        If vFindSecond > 0 Then
                                            sNameSecond = Left(sSecond, vFindSecond - 1) ' Выделяем тип
                                            sNameSecond = Trim(sNameSecond)
                                        Else
                                            iCompare = 1
                                        End If
                                        Exit For
                                    End If
                                Next ii
                            End If
                            If iCompare = 0 Then
                                iResult1 = StrComp(sNameFirst, sNameSecond, 1) ' Сравниваем типы
                                Select Case iResult1
                                Case 1
                                    Result = "S_GREAT"
                                Case -1
                                    Result = "S_LESS"
                                Case 0
                                    ' Сравниваем номера стандартов
                                    sStandardNumberFirst = Right$(sFirst, Len(sFirst) - vStandardNameFirst + 1 - Len(sStandardNameFirst))
                                    sStandardNumberFirst = Trim(sStandardNumberFirst)
                                    sStandardNumberSecond = Right$(sSecond, Len(sSecond) - vStandardNameSecond + 1 - Len(sStandardNameSecond))
                                    sStandardNumberSecond = Trim(sStandardNumberSecond)
                                    If sStandardNumberFirst = "" Or sStandardNumberSecond = "" Then ' Если одна из строк пустая
                                        iCompare = 1
                                    Else
                                        vFindFirst = InStr(sStandardNumberFirst, " ") ' Находим первый пробел с начала
                                        If vFindFirst > 0 Then
                                            sStandardNumberFirst = Left$(sStandardNumberFirst, vFindFirst - 1) ' Выделяем номер стандарта
                                        End If
                                        vFindFirst = InStr(sStandardNumberFirst, "-") ' Находим "-"
                                        If vFindFirst > 0 Then ' Если "-" найден
                                            sStandardNumberFirst = Left$(sStandardNumberFirst, vFindFirst - 1) ' Выделяем номер стандарта
                                        End If

                                        vFindSecond = InStr(sStandardNumberSecond, " ") ' Находим первый пробел с начала
                                        If vFindSecond > 0 Then
                                            sStandardNumberSecond = Left$(sStandardNumberSecond, vFindSecond - 1) ' Выделяем номер стандарта
                                        End If
                                        vFindSecond = InStr(sStandardNumberSecond, "-") ' Находим "-"
                                        If vFindSecond > 0 Then ' Если "-" найден
                                            sStandardNumberSecond = Left$(sStandardNumberSecond, vFindSecond - 1) ' Выделяем номер стандарта
                                        End If

                                        If IsNumeric(sStandardNumberFirst) = True And IsNumeric(sStandardNumberSecond) = True Then ' Если выделенные номера числа, то
                                            iPartFirst = CLng(sStandardNumberFirst)
                                            iPartSecond = CLng(sStandardNumberSecond)
                                            If iPartFirst < iPartSecond Then ' Сравниваем номера как числа
                                                iResult2 = -1
                                            ElseIf iPartFirst > iPartSecond Then
                                                iResult2 = 1
                                            Else
                                                iResult2 = 0
                                            End If
                                        Else ' Если нет,
                                            iResult2 = StrComp(sStandardNumberFirst, sStandardNumberSecond, 1) ' Сравниваем номера как строки
                                        End If
                                        Select Case iResult2
                                        Case 1
                                            Result = "S_GREAT"
                                        Case -1
                                            Result = "S_LESS"
                                        Case 0
                                            ' Сравниваем свойства
                                            ' Определяем положение свойств (конец или начало)
                                            sPartFirst = Left(sFirst, vStandardNameFirst - 1)
                                            sPartFirst = Trim(sPartFirst)
                                            If sPartFirst = sNameFirst Then ' Свойства в конце
                                                vFindFirst = InStr(vStandardNameFirst, sFirst, "-") ' Находим "-"
                                                sPartFirst = Right(sFirst, Len(sFirst) - vFindFirst)
                                            Else ' Свойства в начале
                                                sPartFirst = Mid(sFirst, Len(sNameFirst) + 1, vStandardNameFirst - Len(sNameFirst) - 1)
                                            End If
                                            sPartFirst = Trim(sPartFirst)

                                            sPartSecond = Left(sSecond, vStandardNameSecond - 1)
                                            sPartSecond = Trim(sPartSecond)
                                            If sPartSecond = sNameSecond Then ' Свойства в конце
                                                vFindSecond = InStr(vStandardNameSecond, sSecond, "-") ' Находим "-"
                                                sPartSecond = Right(sSecond, Len(sSecond) - vFindSecond)
                                            Else ' Свойства в начале
                                                sPartSecond = Mid(sSecond, Len(sNameSecond) + 1, vStandardNameSecond - Len(sNameSecond) - 1)
                                            End If
                                            sPartSecond = Trim(sPartSecond)

                                            lPartLenFirst = Len(sPartFirst) ' Длина свойства
                                            lPartLenSecond = Len(sPartSecond) ' Длина свойства

                                            m = 0 ' Если 1 - найдена цифра, если 2 - найдена буква
                                            m1 = 1 ' Счетчик числовых частей
                                            ReDim Preserve sNumFirst(m1)
                                            sNumFirst(m1) = ""
                                            For ii = 1 To lPartLenFirst ' Ищем числовые части
                                                sPartFirst1 = Mid(sPartFirst, ii, 1)
                                                If IsNumeric(sPartFirst1) = True Or sPartFirst1 = "," Then ' Если найденный символ число,
                                                    If m = 2 Then ' и это первое число в части
                                                        m1 = m1 + 1
                                                        ReDim Preserve sNumFirst(m1)
                                                        sNumFirst(m1) = "" ' готовим следующий элемент массива
                                                    End If
                                                    sNumFirst(m1) = sNumFirst(m1) & sPartFirst1 ' добавляем цифру в массив
                                                    m = 1
                                                ElseIf IsNumeric(sPartFirst1) = False And m = 1 Then ' Если не число, но до этого было число
                                                    m = 2
                                                End If
                                            Next ii

                                            m = 0 ' Если 1 - найдена цифра, если 2 - найдена буква
                                            m2 = 1 ' Счетчик числовых частей
                                            ReDim Preserve sNumSecond(m2)
                                            sNumSecond(m2) = ""
                                            For ii = 1 To lPartLenSecond ' Ищем числовые части
                                                sPartSecond1 = Mid(sPartSecond, ii, 1)
                                                If IsNumeric(sPartSecond1) = True Or sPartSecond1 = "," Then ' Если найденный символ число,
                                                    If m = 2 Then ' и это первое число в части
                                                        m2 = m2 + 1
                                                        ReDim Preserve sNumSecond(m2)
                                                        sNumSecond(m2) = "" ' готовим следующий элемент массива
                                                    End If
                                                    sNumSecond(m2) = sNumSecond(m2) & sPartSecond1 ' добавляем цифру в массив
                                                    m = 1
                                                ElseIf IsNumeric(sPartSecond1) = False And m = 1 Then ' Если не число, но до этого было число
                                                    m = 2
                                                End If
                                            Next ii

                                            If sNumFirst(1) <> "" And sNumSecond(1) <> "" Then ' Если в обеих строках найдены числовые части, то
                                                If m2 > m1 Then ' Находим наименьшее число частей
                                                    m = m1
                                                Else
                                                    m = m2
                                                End If

                                                m3 = 0 ' Если 1 - то сравнение прекращается
                                                For ii = 1 To m ' Cравниваем числовые части
                                                    If m3 = 0 Then
                                                        If CDbl(sNumFirst(ii)) = CDbl(sNumSecond(ii)) Then
                                                            iResult3 = 0
                                                        ElseIf CDbl(sNumFirst(ii)) > CDbl(sNumSecond(ii)) Then
                                                            iResult3 = 1
                                                            m3 = 1
                                                        ElseIf CDbl(sNumFirst(ii)) < CDbl(sNumSecond(ii)) Then
                                                            iResult3 = -1
                                                            m3 = 1
                                                        End If
                                                    End If
                                                Next ii
                                            Else ' Если числовых частей нет
                                                iResult3 = StrComp(sPartFirst, sPartSecond, 1) ' просто сравниваем свойства
                                            End If
                                            Select Case iResult3
                                            Case 1
                                                Result = "S_GREAT"
                                            Case -1
                                                Result = "S_LESS"
                                            Case 0
                                                Result = "S_EQUAL"
                                            End Select ' Для iResult3
                                        End Select ' Для iResult2
                                    End If
                                End Select ' Для iResult1
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Else ' Строка из разделов Документация или Комплексы или Сборочные единицы или Детали или Комплекты или другого
        sFirst = sSpecData(i, 3)  ' Поле Обозначение
        sSecond = sSpecData(i + 1, 3) ' Поле Обозначение
        sFirst = Trim(sFirst)
        sSecond = Trim(sSecond)

        If sFirst = "" Or sSecond = "" Then ' Если одна из строк пустая
            If sFirst = "" And sSecond <> "" Then
                Result = "S_GREAT"
            ElseIf sSecond = "" And sFirst <> "" Then
                Result = "S_LESS"
            Else
                Result = "S_EQUAL"
            End If
        ElseIf sSpecData(i, nNumColumn - 5) = "Документация" Or sSpecData(i, nNumColumn - 5) = "Комплекты" Then
        Else
            iCompare = 1
        End If
    End If
Else ' Строки из разных разделов
    If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
        For ii = 0 To UBound(sSectionData)
            If sSpecData(i, nNumColumn - 5) = sSectionData(ii) Then
                m1 = ii
            End If
            If sSpecData(i + 1, nNumColumn - 5) = sSectionData(ii) Then
                m2 = ii
            End If
        Next ii
        If m1 > m2 Then
            Result = "S_GREAT"
        ElseIf m1 < m2 Then
            Result = "S_LESS"
        Else
            Result = "S_EQUAL"
        End If
    Else ' Ведомость покупных
        m1 = UBound(sGroupData) + 1
        m2 = UBound(sGroupData) + 1
        For ii = 0 To UBound(sGroupData) ' Проверяем группу
            If sSpecData(i, nNumColumn - 4) = sGroupData(ii) Then
                m1 = ii
            End If
            If sSpecData(i + 1, nNumColumn - 4) = sGroupData(ii) Then
                m2 = ii
            End If
        Next ii
        If m1 > m2 Then
            Result = "S_GREAT"
        ElseIf m1 < m2 Then
            Result = "S_LESS"
        Else
            For ii = 0 To UBound(sSectionData)
                If sSpecData(i, nNumColumn - 5) = sSectionData(ii) Then
                    m1 = ii
                End If
                If sSpecData(i + 1, nNumColumn - 5) = sSectionData(ii) Then
                    m2 = ii
                End If
            Next ii
            If m1 > m2 Then
                Result = "S_GREAT"
            ElseIf m1 < m2 Then
                Result = "S_LESS"
            Else
                iCompare = 1
            End If
        End If
    End If
End If
If iCompare = 1 Then
    iResult4 = StrComp(sFirst, sSecond, 1) ' Просто сравниваем строки
    Select Case iResult4
    Case 1
        Result = "S_GREAT"
    Case -1
        Result = "S_LESS"
    Case 0
        Result = "S_EQUAL"
    End Select
End If

'Debug.Print Result
End Sub

Private Sub ChkFormat_Click()
If MForm = 0 Then ' Изменения разрешены
    Tests (1)
End If
End Sub
Private Sub Tests(MTests)
If prpTestVersion = 1 Or prpTestFormat = 1 Or prpTestStandard = 1 Then
    strActiveSheetName = swSheet.GetName
    ReDim sFormatArray(UBound(vSheetNames))
    ' Считываем и проверяем форматы всех листов
    intDRWSheet = 0
    k = 0
    k1 = 0
    k2 = 0
    sSheetsNames1 = ""
    sSheetsNames2 = ""
    sSheetsNames3 = ""
    For i = 0 To UBound(vSheetNames)
        ok = swDraw.ActivateSheet(vSheetNames(i))
        Set swSheet = swDraw.GetCurrentSheet
        strSheetFormatName = swSheet.GetSheetFormatName()
        ' Проверка версии и оформления
        If Left$(vSheetNames(i), 3) = "DRW" Or Left$(vSheetNames(i), 4) = "Лист" Or Left$(vSheetNames(i), 5) = "Sheet" Or Left$(vSheetNames(i), 2) = "SP" Or Left$(vSheetNames(i), 2) = "VP" Or Left$(vSheetNames(i), 3) = "LRI" Then
            If prpTestVersion = 1 And MTests = 0 Then
                ' Проверка версии форматки
                strTemp = "Version@" & strSheetFormatName
                ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
                If ok = True Then
                    Set swNote = swSelMgr.GetSelectedObject2(1)
                    strTemp = swNote.GetText()
                    ' Проверка версии
                    If Right$(strTemp, 1) <> "3" Then
                        k1 = k1 + 1
                        sSheetsNames1 = sSheetsNames1 & vSheetNames(i) & ", "
                    End If
                Else
                    k1 = k1 + 1
                    sSheetsNames1 = sSheetsNames1 & vSheetNames(i) & ", "
                End If
            End If
            If prpTestStandard = 1 And MTests = 0 Then
                ' Проверка оформления
                m = 0
                Set swView = swDraw.GetFirstView
                If Not swView Is Nothing Then
                    Set swNote = swView.GetFirstNote()
                    j = 0
                    While j = 0
                        If Not swNote Is Nothing Then
                            Set swAnn = swNote.GetAnnotation()
                            If Not swAnn.OwnerType = swAnnotationOwner_DrawingTemplate Then ' Исключаем объекты форматки
                                Set swNote = swNote.GetNext
                            Else
                                j = 1
                            End If
                        Else
                            j = 1
                        End If
                    Wend
                    If Not swNote Is Nothing Then
                        Set swAnn = swNote.GetAnnotation()
                        Set swTextFormat = swAnn.GetTextFormat(0)
                        If swTextFormat.TypeFaceName <> stdFontName Then
                            m = 1
                        End If
                        If swTextFormat.Italic = True And stdFontItalic = 0 Then
                            m = 1
                        ElseIf swTextFormat.Italic = False And stdFontItalic = 1 Then
                            m = 1
                        End If
                        If swTextFormat.Bold = True And stdFontBold = 0 Then
                            m = 1
                        ElseIf swTextFormat.Bold = False And stdFontBold = 1 Then
                            m = 1
                        End If
                    Else
                        m = 1
                    End If
                Else
                    m = 1
                End If
                Set swView = swView.GetNextView
                If Not swView Is Nothing Then
                    Set swNote = swView.GetFirstNote()
                    If Not swNote Is Nothing Then
                        Set swAnn = swNote.GetAnnotation()
                        Set swTextFormat = swAnn.GetTextFormat(0)
                        If swTextFormat.TypeFaceName <> stdFontName Then
                            m = 1
                        End If
                        If swTextFormat.Italic = True And stdFontItalic = 0 Then
                            m = 1
                        ElseIf swTextFormat.Italic = False And stdFontItalic = 1 Then
                            m = 1
                        End If
                        If swTextFormat.Bold = True And stdFontBold = 0 Then
                            m = 1
                        ElseIf swTextFormat.Bold = False And stdFontBold = 1 Then
                            m = 1
                        End If
                    End If
                End If
                Set swModExt = swDraw.Extension
                Set swTextFormat = swModExt.GetUserPreferenceTextFormat(swDetailingDimensionTextFormat, swDetailingDimension)
                If swTextFormat.TypeFaceName <> stdFontName Or swTextFormat.CharHeight <> stdFontSize / 1000 Then
                    m = 1
                End If
                If swTextFormat.Italic = True And stdFontItalic = 0 Then
                    m = 1
                ElseIf swTextFormat.Italic = False And stdFontItalic = 1 Then
                    m = 1
                End If
                If swTextFormat.Bold = True And stdFontBold = 0 Then
                    m = 1
                ElseIf swTextFormat.Bold = False And stdFontBold = 1 Then
                    m = 1
                End If
                If m = 1 Then
                    k2 = k2 + 1
                    sSheetsNames2 = sSheetsNames2 & vSheetNames(i) & ", "
                End If
            End If
        End If
        If prpTestFormat = 1 And ChkFormat.Value = False And CboType.ListIndex <> 2 Then ' Формат читается из чертежа
            If Left$(vSheetNames(i), 3) = "DRW" Or Left$(vSheetNames(i), 4) = "Лист" Or Left$(vSheetNames(i), 5) = "Sheet" Or Left$(vSheetNames(i), 3) = "LRI" Then
                ' Проверка имени формата
                strTemp = "Format@" & strSheetFormatName
                ok = swDraw.Extension.SelectByID2(strTemp, "NOTE", 0, 0, 0, False, 0, Nothing, 0)
                If ok = True Then
                    Set swNote = swSelMgr.GetSelectedObject2(1)
                    strTemp = swNote.GetText()
                    ' Проверка корректности и длины записи
                    If Len(Trim(strTemp)) > 8 And Left$(strTemp, 6) = "Формат" Then
                        sFormatArray(intDRWSheet) = Right$(strTemp, Len(strTemp) - 7)
                        intDRWSheet = intDRWSheet + 1
                    Else
                        k = k + 1
                        sSheetsNames3 = sSheetsNames3 & vSheetNames(i) & ", "
                    End If
                Else
                    k = k + 1
                    sSheetsNames3 = sSheetsNames3 & vSheetNames(i) & ", "
                End If
            End If
        End If
    Next i
    If k1 > 0 Then
        sSheetsNames1 = Left$(sSheetsNames1, Len(sSheetsNames1) - 2)
        strMsg = "Лист(ы) " & sSheetsNames1 & " имеют нестандартную или устаревшую основную надпись." & Chr$(10) & "Текст основной надписи может отображаться неверно." & Chr$(10) & "Для исправления используйте макрос DProp"
        lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbOk)
    End If
    If k2 > 0 Then
        sSheetsNames2 = Left$(sSheetsNames2, Len(sSheetsNames2) - 2)
        strMsg = "Лист(ы) " & sSheetsNames2 & " имеют ошибки оформления." & Chr$(10) & "Для исправления используйте макрос DProp"
        lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbOk)
    End If
    If prpTestFormat = 1 Then ' Есть проверка формата
        If ChkFormat.Value = False And CboType.ListIndex <> 2 Then ' Формат читается из чертежа
            CboFormat.Enabled = False
            If k = 0 And intDRWSheet > 0 Then ' Все прочитанные форматы определены
                ' Определяем число листов
                If intDRWSheet > 1 Then ' Листов больше одного
                    m = 0
                    ' Сортируем форматы
                    For i = 0 To intDRWSheet - 1
                        strTemp = sFormatArray(i)
                        n = i
                        For j = i To intDRWSheet - 2
                            ' Длина равна, левые части нет
                            If Len(strTemp) = Len(sFormatArray(j + 1)) And Left$(strTemp, 2) <> Left$(sFormatArray(j + 1), 2) Then
                                iResult = StrComp(Left$(sFormatArray(j + 1), 2), Left$(strTemp, 2), 1)
                                Select Case iResult
                                Case -1 ' меньше
                                    m = 1
                                Case 0 ' равняется
                                Case 1 ' больше
                                    strTemp = sFormatArray(j + 1)
                                    n = j + 1
                                    m = 1
                                End Select
                            ' Длина не равна, левые части равны
                            ElseIf Len(strTemp) <> Len(sFormatArray(j + 1)) And Left$(strTemp, 2) = Left$(sFormatArray(j + 1), 2) Then
                                iResult = StrComp(sFormatArray(j + 1), strTemp, 1)
                                Select Case iResult
                                Case -1
                                    strTemp = sFormatArray(j + 1)
                                    n = j + 1
                                    m = 1
                                Case 0
                                Case 1
                                    m = 1
                                End Select
                            ' Длина равна, левые части тоже
                            ElseIf Len(strTemp) = Len(sFormatArray(j + 1)) And Left$(strTemp, 2) = Left$(sFormatArray(j + 1), 2) Then
                                iResult = StrComp(Right$(sFormatArray(j + 1), 1), Right$(strTemp, 1), 1)
                                Select Case iResult
                                Case -1
                                    strTemp = sFormatArray(j + 1)
                                    n = j + 1
                                    m = 1
                                Case 0
                                Case 1
                                    m = 1
                                End Select
                            ' Длина не равна, левые части не равны
                            Else
                                iResult = StrComp(Left$(sFormatArray(j + 1), 2), Left$(strTemp, 2), 1)
                                Select Case iResult
                                Case -1
                                    m = 1
                                Case 0
                                Case 1
                                    strTemp = sFormatArray(j + 1)
                                    n = j + 1
                                    m = 1
                                End Select
                            End If
                        Next j
                        sFormatArray(n) = sFormatArray(i)
                        sFormatArray(i) = strTemp
                    Next i
                End If
                ' Заносим формат
                If m = 0 Or intDRWSheet = 1 Then   ' Все форматы одинаковые или формат всего один
                    If Len(sFormatArray(0)) > 2 Then ' Формат кратный
                        CboFormat.ListIndex = 7
                        TxtRemark.Value = "*) " & sFormatArray(0)
                    Else ' Формат обычный
                        CboFormat.Value = sFormatArray(0)
                    End If
                Else 'Форматов много и они разные
                    ' Формируем запись форматов в примечание
                    strTemp = ""
                    For i = 0 To intDRWSheet - 1
                        If i <> intDRWSheet - 1 Then
                            If sFormatArray(i) <> sFormatArray(i + 1) Then
                                strTemp = strTemp & " " & sFormatArray(i) & ","
                            End If
                        Else
                            strTemp = strTemp & " " & sFormatArray(i) & ","
                        End If
                    Next i
                    CboFormat.ListIndex = 7
                    TxtRemark.Value = "*)" & Left$(strTemp, Len(strTemp) - 1)
                End If
                If CboFormat.ListIndex = 7 Then
                    TxtRemark.Enabled = False
                Else
                    TxtRemark.Enabled = True
                End If
            ElseIf k = 0 And intDRWSheet = 0 Then ' Нет подходящих листов чертежа
                swApp.SendMsgToUser ("Формат не определен.")
                CboFormat.Value = ""
                TxtRemark.Enabled = True
            Else ' Один или более форматов не определены
                sSheetsNames3 = Left$(sSheetsNames3, Len(sSheetsNames3) - 2)
                strMsg = "Лист(ы) " & sSheetsNames3 & " не позволяют определить формат." & Chr$(10) & "Для исправления используйте макрос DProp"
                lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbOk)
                CboFormat.Value = ""
                TxtRemark.Enabled = True
            End If
        Else ' Формат устанавливается пользователем
            CboFormat.Enabled = True
            TxtRemark.Enabled = True
        End If
        ' Очистка Примечания от *)
        strTemp = TxtRemark.Value
        'Debug.Print "TxtRemark.Value=", TxtRemark.Value
        'Debug.Print "CboFormat.Value=", CboFormat.Value
        If CboFormat.Value <> "*)" And Left$(strTemp, 2) = "*)" Then
            'Debug.Print "***"
            TxtRemark.Value = ""
        End If
    End If
    ' Возвращаем активный лист
    ok = swDraw.ActivateSheet(strActiveSheetName)
    Set swSheet = swDraw.GetCurrentSheet
End If
End Sub

Function RealText(RichText As String) As String
Dim n1 As Integer ' Начало
Dim n2 As String ' Длина
Dim DelText As String
While InStr(RichText, "<") > 0
    n1 = InStr(RichText, "<")
    n2 = InStr(RichText, ">") - n1 + 1
    DelText = Mid$(RichText, n1, n2)
    RichText = Replace(RichText, DelText, "")
Wend
RealText = RichText
End Function

Private Sub CmdAbout_Click()
    swApp.SendMsgToUser ("Made by Leon, 2017")
End Sub

Private Sub LstConfigTest() ' Проверка выбранных конфигураций
ConfigTest = 0
mConfigCount = 0
j = 0
For i = 0 To LstConfig.ListCount - 1
    If LstConfig.Selected(i) = True Then
        j = j + 1
    End If
Next i
If j > 0 Then
    ConfigTest = 1
    If j > 9 Then
        mConfigCount = 1
    End If
End If
End Sub

Private Sub RView()
vSheetNames = swDraw.GetSheetNames
Set swBomFeat = swTable.BomFeature
vVisible = Null
vConfVisibleSP = swBomFeat.GetConfigurations(True, vVisible)
For i = 0 To UBound(vSheetNames)
    If (Left$(vSheetNames(i), 3) = "DRW" Or Left$(vSheetNames(i), 4) = "Лист" Or Left$(vSheetNames(i), 5) = "Sheet") Then
        ok = swDraw.ActivateSheet(vSheetNames(i))
        Set swSheet = swDraw.GetCurrentSheet
        Set swView = swDraw.GetFirstView
        Set swView = swView.GetNextView ' Получаем первый вид
        Do Until swView Is Nothing
            strTemp = swView.ReferencedConfiguration ' Имя конфигурации вида
            m = 0
            If CboType.ListIndex = 1 Then  ' Групповая спецификация
                For j = 0 To UBound(vConfVisibleSP)
                    If strTemp = vConfVisibleSP(j) Then
                        m = 1
                        Exit For
                    End If
                Next j
            Else
                If strTemp = sConfigName Then
                    m = 1
                End If
            End If
            If m = 0 Then
                Set swBomFeat = swTable.BomFeature
                Set swFeat = swBomFeat.GetFeature
                strTemp = swFeat.Name
                ok = swView.SetKeepLinkedToBOM(True, strTemp)
            End If
            Set swView = swView.GetNextView
        Loop
    End If
Next i
Finish
End Sub

Sub MyProperties()
' Чтение ini файла
Open sSource15 For Input As #1
    Line Input #1, strTemp
    prpNumber = strTemp ' Обозначение
    Line Input #1, strTemp
    prpDocCode = strTemp ' Код документа
    Line Input #1, strTemp
    prpDocDescription = strTemp ' Наименование документа
    Line Input #1, strTemp
    prpDescription = strTemp ' Наименование изделия в одну строку
    Line Input #1, strTemp
    prpDescriptionMulti = strTemp ' Наименование изделия в несколько строк
    Line Input #1, strTemp
    prpCode = strTemp ' Условное наименование (код)
    Line Input #1, strTemp
    prpFormat = strTemp ' Формат
    Line Input #1, strTemp
    prpRemark = strTemp ' Примечание
    Line Input #1, strTemp
    prpLit = strTemp ' Литера
    Line Input #1, strTemp
    prpLitTable = strTemp ' Литера для таблицы параметров
    Line Input #1, strTemp
    prpFirm = strTemp ' Наименование организации
    Line Input #1, strTemp
    prpSection = strTemp ' Раздел
    Line Input #1, strTemp
    prpGroup = strTemp ' Группа
    '
    Line Input #1, strTemp
    prpDesigner = strTemp ' Разраб.
    Line Input #1, strTemp
    prpTester = strTemp ' Пров.
    Line Input #1, strTemp
    prpTechcontrol = strTemp ' Т.контр.
    Line Input #1, strTemp
    prpWorkType = strTemp ' Характер работы
    Line Input #1, strTemp
    prpPerson = strTemp ' Фамилия для "Характер работы"
    Line Input #1, strTemp
    prpNormcontrol = strTemp ' Н.контр
    Line Input #1, strTemp
    prpApprove = strTemp ' Утв.
    '
    Line Input #1, strTemp
    prpMass = strTemp ' Масса
    Line Input #1, strTemp
    prpMassTable = strTemp ' Масса для таблицы параметров
    Line Input #1, strTemp
    prpMaterial = strTemp ' Материал
    Line Input #1, strTemp
    prpMaterialTable = strTemp ' Материал для таблицы параметров
    '
    Line Input #1, strTemp
    prpFirstApply = strTemp ' Перв.примен. для чертежей и ВП
    Line Input #1, strTemp
    prpInformNumber = strTemp ' Справ.№ для чертежей
    '
    Line Input #1, strTemp
    prpFirstApplySP = strTemp ' Перв.примен. для спецификации
    Line Input #1, strTemp
    prpInformNumberSP = strTemp ' Справ.№ для спецификаций
    Line Input #1, strTemp
    prpLitSP = strTemp ' Литера для спецификаций
    '
    Line Input #1, strTemp
    prpInformNumberVP = strTemp ' Справ.№ для ВП
    Line Input #1, strTemp
    prpDescriptionVP = strTemp ' Наименование для ВП
    Line Input #1, strTemp
    prpProductCodeVP = strTemp ' Код продукции
    Line Input #1, strTemp
    prpNumberDocVP = strTemp ' Обозначение документа на поставку
    Line Input #1, strTemp
    prpVendorVP = strTemp ' Поставщик
    Line Input #1, strTemp
    prpRemarkVP = strTemp ' Примечание для ВП
    '
    Line Input #1, strTemp
    prpProject = strTemp ' Проект (дополнительное свойство)
    Line Input #1, strTemp
    prpDraftNumber = strTemp ' Эскизное Обозначение (дополнительное свойство)
    Line Input #1, strTemp
    prpDraftDescription = strTemp ' Эскизное Наименование (дополнительное свойство)
    Line Input #1, strTemp
    prpDraftFirstApply = strTemp ' Эскизное Перв.примен. для чертежей и ВП(дополнительное свойство)
    Line Input #1, strTemp
    prpDraftFirstApplySP = strTemp ' Эскизное Перв.примен. для спецификации (дополнительное свойство)
    '
    Line Input #1, strTemp
    prpBlank = strTemp ' Заготовка
    '
    Line Input #1, strTemp
    prpBor = strTemp ' Заимствование
    '
    Line Input #1, strTemp
    prpQuantity = strTemp ' Количество в СП
    '
    Line Input #1, strTemp
    If strTemp = "1" Then ' Проверка версии
        prpTestVersion = 1
    Else
        prpTestVersion = 0
    End If
    Line Input #1, strTemp
    If strTemp = "1" Then ' Проверка формата
        prpTestFormat = 1
    Else
        prpTestFormat = 0
    End If
    Line Input #1, strTemp
    If strTemp = "1" Then ' Проверка имен
        prpTestName = 1
    Else
        prpTestName = 0
    End If
    Line Input #1, strTemp
    If strTemp = "1" Then ' Проверка оформления
        prpTestStandard = 1
    Else
        prpTestStandard = 0
    End If
    '
    Line Input #1, strTemp
    If strTemp = "1" Then ' Имя файла
        prpFileName = 1
    Else
        prpFileName = 0
    End If
    Line Input #1, strTemp
    prpNameSep = strTemp ' Разделитель
    '
    Line Input #1, strTemp
    If strTemp = "1" Then ' Управление шрифтом
        prpFontSize = 1
    Else
        prpFontSize = 0
    End If
    '
    Line Input #1, strTemp
    Line Input #1, strTemp
    If strTemp = "1" Then ' Доп. свойство №1
        prpAddPRP1 = 1
    Else
        prpAddPRP1 = 0
    End If
    Line Input #1, strTemp
    Line Input #1, strTemp
    If strTemp = "1" Then ' Доп. свойство №2
        prpAddPRP2 = 1
    Else
        prpAddPRP2 = 0
    End If
    '
    Line Input #1, strTemp
    If strTemp = "1" Then ' Окно макроса в левом верхнем углу
        prpLeftTopCorner = 1
    Else
        prpLeftTopCorner = 0
    End If
    Line Input #1, strTemp
    If strTemp = "1" Then ' Окно макроса поверх всех
        prpTopAll = 1
    Else
        prpTopAll = 0
    End If
Close #1
End Sub

Sub MyStandard()
' Чтение ini файла
Open sSource16 For Input As #1
    Line Input #1, strTemp ' Шрифт
    stdFontName = strTemp
    Line Input #1, strTemp ' Размер шрифта
    strTemp = Replace(strTemp, ".", ",")
    stdFontSize = CDbl(strTemp)
    Line Input #1, strTemp ' Наклонный
    If strTemp = "1" Then
        stdFontItalic = 1
    Else
        stdFontItalic = 0
    End If
    Line Input #1, strTemp ' Жирный
    If strTemp = "1" Then
        stdFontBold = 1
    Else
        stdFontBold = 0
    End If
        Line Input #1, strTemp
    stdDay = strTemp
    Line Input #1, strTemp
    stdMonth = strTemp
    Line Input #1, strTemp
    stdYear = strTemp
    Line Input #1, strTemp
    stdHour = strTemp
    Line Input #1, strTemp
    stdMinute = strTemp
    Line Input #1, strTemp
    stdSecond = strTemp
Close #1
' Проверяем дату у файла стандарта
MyDateTime = FileDateTime(sSource17)
If stdDay = Day(MyDateTime) And stdMonth = Month(MyDateTime) And stdYear = Year(MyDateTime) And stdHour = Hour(MyDateTime) And stdMinute = Minute(MyDateTime) And stdSecond = Second(MyDateTime) Then
Else
    strTemp = swApp.GetUserPreferenceStringValue(swDefaultTemplateDrawing)
    Set swDraw1 = swApp.NewDocument(strTemp, 0, 0, 0)
    Set swModExt = swDraw1.Extension
    ok = swModExt.LoadDraftingStandard(sSource17)
    Set swTextFormat = swModExt.GetUserPreferenceTextFormat(swDetailingDimensionTextFormat, swDetailingDimension)
    strTemp = swDraw1.GetTitle
    swApp.QuitDoc strTemp

    stdFontName = swTextFormat.TypeFaceName
    stdFontSize = swTextFormat.CharHeight * 1000
    If swTextFormat.Italic Then
        stdFontItalic = 1
    Else
        stdFontItalic = 0
    End If
    If swTextFormat.Bold Then
        stdFontBold = 1
    Else
        stdFontBold = 0
    End If

    ' Запись ini
    Open sSource16 For Output As #1
        Print #1, stdFontName
        strTemp = LTrim(CStr(stdFontSize))
        strTemp = Replace(strTemp, ".", ",")
        Print #1, strTemp
        If stdFontItalic = 1 Then
            Print #1, "1"
        Else
            Print #1, "0"
        End If
        If stdFontBold = 1 Then
            Print #1, "1"
        Else
            Print #1, "0"
        End If
        strTemp = Day(MyDateTime)
        Print #1, strTemp
        strTemp = Month(MyDateTime)
        Print #1, strTemp
        strTemp = Year(MyDateTime)
        Print #1, strTemp
        strTemp = Hour(MyDateTime)
        Print #1, strTemp
        strTemp = Minute(MyDateTime)
        Print #1, strTemp
        strTemp = Second(MyDateTime)
        Print #1, strTemp
    Close #1
End If
End Sub


Private Sub tempAddRow()
' Добавляем строки для корректного переноса
nNumRow = swTable.RowCount
dblTemp = 0#
For i = 1 To nNumRow - 1 ' Вычисляем общую высоту таблицы
    dblTemp = dblTemp + swTable.GetRowHeight(i)
Next i
k = 1 ' Метка конца таблицы
n = nFirst
i = 0
If dblTemp > nFirst * 0.008 Then ' Если не помещаемся на одном листе
    While k = 1
        k = 0
        k1 = 0
        ' Проверяем многострочные записи
        dblTemp = 0#
        j = 0
        While dblTemp < n * 0.008 ' Определяем количество строк на одном листе
            j = j + 1
            dblTemp = dblTemp + swTable.GetRowHeight(j)
        Wend
        If dblTemp > n * 0.008 Then ' Определяем, есть ли высокая строка на границе и количество добавляемых строк
            dblTemp = dblTemp - n * 0.008
            k1 = CInt(dblTemp / 0.008)
        End If
        For jj = 1 To k1 ' Добавляем строки
            ok = swTable.InsertRow(swTableItemInsertPosition_Before, j)
            swTable.Text(j, 2) = " "
            dRetval = swTable.SetRowHeight(j, 0.008, swTableRowColChange_TableSizeCanChange)
        Next jj
        ' Боремся с подвисшими заголовками
        If CboType.ListIndex = 0 Or CboType.ListIndex = 1 Then  ' Спецификация или Групповая спецификация
            jjj = 4
        Else ' Ведомость покупных
            jjj = 1
        End If
        Set swTextFormat = swTable.GetCellTextFormat(j - k1, jjj) ' Проверяем ячейку в последней (если не было добавлений) строке страницы
        If swTextFormat.Underline Then  ' Добавляем строки
            k2 = CInt(swTable.GetRowHeight(j - k1) / 0.008) ' Определяем количество добавляемых строк
            For jj = 1 To k2 + k1 ' Добавляем строки
                ok = swTable.InsertRow(swTableItemInsertPosition_Before, j - k1)
                swTable.Text(j - k1, 2) = " "
                dRetval = swTable.SetRowHeight(j - k1, 0.008, swTableRowColChange_TableSizeCanChange)
            Next jj
                For jj = 1 To k1 ' Удаляем лишние строки
                    ok = swTable.DeleteRow(j + 2)
                Next jj
        Else    ' Проверяем предпоследнюю строку страницы
            Set swTextFormat = swTable.GetCellTextFormat(j - 1 - k1, jjj) ' Проверяем ячейку в предпоследней (если не было добавлений) строке страницы
            If swTextFormat.Underline Then  ' Добавляем строки
                k2 = CInt(swTable.GetRowHeight(j - 1 - k1) / 0.008) + 1 ' Определяем количество добавляемых строк
                For jj = 1 To k2 + k1 ' Добавляем строки
                    ok = swTable.InsertRow(swTableItemInsertPosition_Before, j - 1 - k1)
                    swTable.Text(j - 1 - k1, 2) = " "
                    dRetval = swTable.SetRowHeight(j - 1 - k1, 0.008, swTableRowColChange_TableSizeCanChange)
                Next jj
                For jj = 1 To k1 ' Удаляем лишние строки
                    ok = swTable.DeleteRow(j + 2)
                Next jj
            End If
        End If
        nNumRow = swTable.RowCount
        dblTemp = 0
        For j = 1 To nNumRow - 1 ' Вычисляем общую высоту таблицы
            dblTemp = dblTemp + swTable.GetRowHeight(j)
        Next j
        i = i + 1
        If dblTemp > (nFirst + i * nSecond) * 0.008 Then ' Работаем со следующим листом
            k = 1
            n = nFirst + i * nSecond
        End If
        If i = 300 Then
            End
        End If
     Wend
End If
End Sub


Private Sub Temp_CmdAddFormat_Click()
nNumRow = swTable.RowCount
If CboType.ListIndex = 1 And iForm1 = 1 Then ' Групповая спецификация и выбрано убирать базовую часть обозначения для исполнений
    j = 0
    For i = 1 To nNumRow - 1
        If i <> 1 Then ' Проверяем обозначения для исполнений
            If swTable.Text(i, 3) <> "" Then
                varTemp = InStr(swTable.Text(i, 3), "-")
                If varTemp > 0 Then ' Есть исполнение
                    j = j + 1
                    If Left$(swTable.Text(i, 3), 1) <> "-" Then ' Обозначение не укорочено, Сравниваем с базовой частью обозначения
                        If Left$(swTable.Text(i, 3), varTemp - 1) = swTable.Text(i - j, 3) Then ' Совпадают
                            swTable.Text(i, 3) = Right$(swTable.Text(i, 3), varTemp)
                            If iForm0 = 1 Then ' Помечаем цветом
                                ' Устанавливаем цвет
                            End If
                        End If
                    End If
                Else
                    j = 0
                End If
            Else
                If j <> 0 Then
                    j = j + 1
                End If
            End If
        End If
    Next i
End If

If iForm2 = 1 Then ' Группировать стандартные
    i = 1
    jj = 1 ' Счетчик нужных строк
    j = 0 ' Номер первой строки одного ГОСТа
    n = 0 ' Метка конца одинаковых строк
    k = 1 ' Метка конца таблицы
    k1 = 1 ' Метка конца отбора первой строки
    k2 = 1 ' Метка конца отбора второй строки
    While k = 1
        Do While k1 = 1 ' Определяем первую строку
            If swTable.Text(i, 2) <> " " And swTable.Text(i, 2) <> "-" And swTable.Text(i, 3) = "" And swTable.Text(i, 4) <> "" Then ' Отсееваем лишние строки
                strTemp = swTable.Text(i, 4)
                Debug.Print strTemp, "jj=", jj
                ReDim Preserve iTempArr(jj)
                iTempArr(jj) = i
                jj = jj + 1
                Exit Do
            Else
                i = i + 1
            End If
            nNumRow = swTable.RowCount
            If i >= nNumRow - 2 Then
                k1 = 0
                Exit Do
            End If
        Loop
        If k1 <> 0 Then
            Do While k2 = 1 ' Определяем вторую строку
                If swTable.Text(i + 1, 2) <> " " And swTable.Text(i + 1, 2) <> "-" And swTable.Text(i + 1, 3) = "" And swTable.Text(i + 1, 4) <> "" Then ' Отсееваем лишние строки
                    strTemp1 = swTable.Text(i + 1, 4)
                    Exit Do
                Else
                    i = i + 1
                End If
                nNumRow = swTable.RowCount
                If i >= nNumRow - 2 Then
                    k2 = 0
                    Exit Do
                End If
            Loop
        End If
        If k1 <> 0 And k2 <> 0 Then
            ' Заменяем переносы на пробелы
            strTemp = Replace(strTemp, Chr$(13) & Chr$(10), " ")
            strTemp = Replace(strTemp, Chr$(10), " ")
            strTemp1 = Replace(strTemp1, Chr$(13) & Chr$(10), " ")
            strTemp1 = Replace(strTemp1, Chr$(10), " ")
            varTemp = InStrRev(strTemp, " ") ' Находим первый пробел с конца
            If varTemp > 0 Then
                varTemp1 = InStrRev(strTemp, " ", varTemp - 1) ' Находим второй пробел с конца
                If varTemp1 > 0 Then
                    Debug.Print Trim(Mid$(strTemp, varTemp1 + 1, varTemp - varTemp1 - 1))
                    If Trim(Mid$(strTemp, varTemp1 + 1, varTemp - varTemp1 - 1)) = "Р" Then
                        varTemp1 = InStrRev(strTemp, " ", varTemp1 - 1) ' Находим третий пробел с конца
                    End If
                    If varTemp1 > 0 Then
                        If Len(strTemp) > varTemp1 And Len(strTemp1) > varTemp1 Then ' Сравниваем стандарты
                            Debug.Print "Строки", strTemp, strTemp1
                            Debug.Print "1", "*" & Right$(strTemp, Len(strTemp) - varTemp1) & "*"
                            Debug.Print "2", "*" & Right$(strTemp1, Len(strTemp) - varTemp1) & "*"
                            Debug.Print "**************"
                            If Right$(strTemp, Len(strTemp) - varTemp1) = Right$(strTemp1, Len(strTemp) - varTemp1) Then ' Госты равны
                                If j = 0 Then
                                    strTemp2 = Right$(strTemp, Len(strTemp) - varTemp1) ' ГОСТ
                                    varTemp = InStr(strTemp, " ")
                                    strTemp3 = Left$(strTemp, varTemp - 1) ' Тип
                                    Select Case strTemp3
                                    Case "Болт"
                                        strTemp4 = "Болты " & strTemp2
                                    Case "Винт"
                                        strTemp4 = "Винты " & strTemp2
                                    Case "Гайка"
                                        strTemp4 = "Гайки " & strTemp2
                                    Case "Шайба"
                                        strTemp4 = "Шайбы " & strTemp2
                                    Case "Шпонка"
                                        strTemp4 = "Шпонки " & strTemp2
                                    Case "Штифт"
                                        strTemp4 = "Штифты " & strTemp2
                                    Case "Кольцо"
                                        strTemp4 = "Кольца " & strTemp2
                                    Case "Подшипник"
                                        strTemp4 = "Подшипники " & strTemp2
                                    Case "Шарик"
                                        strTemp4 = "Шарики " & strTemp2
                                    Case "Шпилька"
                                        strTemp4 = "Шпильки " & strTemp2
                                    Case "Шуруп"
                                        strTemp4 = "Шурупы " & strTemp2
                                    Case Else
                                        strTemp4 = strTemp3 & " " & strTemp2
                                    End Select
                                    j = jj - 1 ' Запоминаем первую строчку
                                End If
                                n = 1
                            End If
                        End If
                    End If
                End If
            End If
        End If
        nNumRow = swTable.RowCount
        If i >= nNumRow - 1 Then
            n = 0
            i = i + 1
        End If
        If j <> 0 And n = 0 Then ' Строчки с одним ГОСТом кончились
            For ii = j To jj - 1
                strTemp = swTable.Text(iTempArr(ii), 4)
                strTemp = Replace(strTemp, Chr$(13) & Chr$(10), " ")
                strTemp = Replace(strTemp, Chr$(10), " ")
                strTemp = RTrim(Left$(strTemp, Len(strTemp) - Len(strTemp2))) ' Отрезаем ГОСТ
                If strTemp3 <> "Шайба" Then ' Отрезаем Тип
                    strTemp = LTrim(Right$(strTemp, Len(strTemp) - Len(strTemp3)))
                End If
                swTable.Text(iTempArr(ii), 4) = strTemp
                If iForm0 = 1 Then ' Помечаем цветом
                    ' Устанавливаем цвет
                End If
            Next ii
            ok = swTable.InsertRow(swTableItemInsertPosition_Before, iTempArr(j))
            swTable.Text(iTempArr(j), 2) = " "
            swTable.Text(iTempArr(j), 4) = strTemp4
            i = i + 1
            j = 0
        End If
        n = 0
        i = i + 1
        nNumRow = swTable.RowCount
        If i > nNumRow - 1 Then
            k = 0
        End If
        Debug.Print "i=", i
    Wend
    MFormat = 1
    'CmdFormat_Click ' Форматирование
    MFormat = 0
End If

End Sub