проблема с excel

RENaissance
Дата: 25.04.2011 13:55:21
Титов
Anatoly Podgoretsky,

ну блин в vb это же как-то реализовали начит можно как-то реализовать и на дельфе!))

VB'шный код в студию!
Gwa
Дата: 25.04.2011 13:56:31
Титов,
OLE Automation Вам в руки.. а там всё возможно..
Соколинский Борис
Дата: 25.04.2011 13:57:10
Титов
ну блин в vb это же как-то реализовали начит можно как-то реализовать и на дельфе!))
Можно. Но см. ниже:
анекдот
Заходят мужички к Батюшке
- Отслужи, мол, Батюшка, молебен. Сколько денюжек надобно?
/Батюшка, знамо дело, с характерным раскатистым "О", отвечает/
- Молебен? Отчего не Отслужить? Рублик мОлебен стоить будет.
- Дороговато рублик нам, Батюшка... Может подешевле?
- ПОдешевле хОтите? Ну, давайте, за пОлтинничек отслужу.
- Да, тоже дороговато, Батюшка.
- Ну уж, раз вам так надо, мОгу за двугривенный Отслужить.
- Батюшка, а нельзя за пять копеечек?
- Хм... Ну, чтО сказать? МОжно и за пять кОпеечек... НО МОЛЕБЕН БУДЕТ ГОВНО
Титов
Дата: 25.04.2011 13:58:10
RENaissance,

хе хе предупреждаю сразу бл?*:!во еще то!)) так что не пугайтесть пожалуйсто его!)) сильно
Титов
Дата: 25.04.2011 14:01:05
Титов,

'**********************************************************************
'VedPok_KD.vbp
'Ôîðìèðîâàíèå âåäîìîòè ïîêóïíûõ èçäåëèé â ÊÄ
'Ñîôðîíîâà Àíàñòàñèÿ Þðüåâíà
'19.02.2008
'Âåðñèÿ 1.0
'**********************************************************************
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CallWindowProc Lib "User32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long

Dim SmSession As ISmSession
Dim MetaInfo As SmMetaInfo
Dim Metaobj As SmMetaInfo
Dim prmobject As ISmObject
Dim SmApp As SmApplication
Dim GUISrv As SmGUIServices
Dim Excel As Object
Dim behavior As ISmBehavior
Dim us As Integer
Dim dc As New ADODB.Connection
'Ïåðåìåííûå êîëè÷åñòâà ñòðîê è ëèñòîâ
Dim prim_z As String
Dim prim_z2 As String
Dim nlist As Integer
Dim r As Integer
Dim ns As Integer
Dim nl As Integer
Dim ns2 As Integer
Dim sh As Integer
Dim add As Integer
Dim ob As Integer
Dim user As ISmObject
Dim MAIN_SECURE_USER_ROLE As Integer
Dim sRet As String
Dim w, w1 As Integer
Dim h As Integer
Dim q As Integer
Dim kod_var As String
Dim ispoln_1 As ADODB.Recordset
Dim ispoln As ADODB.Recordset
Dim mas As ADODB.Recordset
Dim kolcount As Integer
Dim obozn As String
Dim ispoln2 As Long


Private Sub Command1_Click()
                     Unload Me
End Sub
'******************************************************
'Ãëàâíûé ìîäóëü ôîðìèðîâàíèÿ âåäîìîñòè ïîêóïíûõ èçäåëèé
'******************************************************
Sub Ved_Pok()
    Rem åñëè áûëà âûáðàíà åäèíè÷íàÿ âåäîìîñòü òî ïåðåìåííîé kolcount ïðèñâàèâàåòñÿ åäèíèöà
    If Option1.Value = True Then kolcount = 1          ' åäèíè÷íàÿ
    Rem Èçìåíåíèÿ íà îêíå âèçóàëèçàöèè âåäîìîñòè
    frmProgrBar.Check1.SetFocus
    frmProgrBar.Check1.FontBold = True
    frmProgrBar.ProgressBar1.Value = 0
    DoEvents
       

    
    
'    Dim del As New ADODB.Recordset
 '   Set del = New ADODB.Recordset
  '  del.ActiveConnection = dc
   ' With del
    '    delsql = "delete from extentional.glavnaia g where g.USERS_OBJECT =" + CStr(us)
     '   .CursorLocation = adUseServer
      '  .CursorType = adOpenStatic
       ' .LockType = adLockOptimistic
'    End With
 '   del.Open delsql
                     
'    Dim del_1 As New ADODB.Recordset
 '   Set del_1 = New ADODB.Recordset
  '  del_1.ActiveConnection = dc
   ' With del_1
    '    del_1sql = "delete from extentional.child g where g.user_ob=" + CStr(us)
     '   .CursorLocation = adUseServer
      '  .CursorType = adOpenStatic
       ' .LockType = adLockOptimistic
  '  End With
   ' del_1.Open del_1sql
       
'    Dim del2 As New ADODB.Recordset
 '   Set del2 = New ADODB.Recordset
  '  del2.ActiveConnection = dc
   ' With del2
    '    del2sql = "delete from extentional.obshie g where g.USERS_OBJECT =" + CStr(us)
     '   .CursorLocation = adUseServer
      '  .CursorType = adOpenStatic
       ' .LockType = adLockOptimistic
 '   End With
  '  del2.Open del2sql
  
    Rem ñîõðàíåíèå ïîëíîãî ñîñòàâà èçäåëèÿ âêëþ÷àÿ èçãîòàâëèâàåìûå äåòàëè â recordset glav2
    Dim glav2 As ADODB.Recordset
    Set glav2 = New ADODB.Recordset
    glav2.ActiveConnection = dc
    With glav2
        glavsql2 = "select *  from konstr__tree k, tn_konstr_doc t where " + _
                   " k.object_id1=" + CStr(prmobject.ObjectId) + _
                   " and k.object_id2=t.object_id"
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    glav2.Open glavsql2
    Rem ïðîâåðêà íà íàëè÷èå ñîñòàâà èçäåëèÿ
    If glav2.RecordCount = 0 Then
        MsgBox "Îòñóòñòâóåò ñîñòàâ ñáîðî÷íîé åäèíèöû!", vbCritical
        Unload frmMain
        Exit Sub
    End If
    glav2.Close

    '*************************************
    'Ïðîâåðêà íà íàëè÷èå äåòåé íå ïîñëåäíåé âåðñèè
    Dim glav1 As ADODB.Recordset
    Set glav1 = New ADODB.Recordset
    glav1.ActiveConnection = dc
    With glav1
        glavsql1 = "select *  from konstr__tree k, tn_konstr_doc t where " + _
                   " k.object_id1=" + CStr(prmobject.ObjectId) + _
                   " and k.object_id2=t.object_id and t.revision_stg = 0 and t.class_id!=1572 and t.class_id!=2886 and t.class_id!=1576"
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    glav1.Open glavsql1
    If glav1.RecordCount > 0 Then
        MsgBox " ñîñòàâå ñáîðî÷íîé åäèíèöû èìåþòñÿ íå ïîñëåäíèå âåðñèè!" + " " + _
               "Ñäàéòå èõ ÐÓÊÎÂÎÄÈÒÅËÞ!!!", vbCritical
        Unload frmMain
        Exit Sub
    End If
    glav1.Close

 '**************************************
    If prmobject.Value("CN_KD_KOD_RODITEL") = "" Then
        kod_var = " "
    Else
        kod_var = prmobject.Value("CN_KD_KOD_RODITEL")
    End If
       
'Ïðîâåðêà íà âåðñèþ íà ðåäàêòèðîâàíèè
    Dim SPEC As ADODB.Recordset
    Set SPEC = New ADODB.Recordset
    SPEC.ActiveConnection = dc
    With SPEC
        SPECsql = "select * from tn_konstr_doc k, DOC_VED_KONSTR d  where k.class_id=2734 " + _
                  " and k.object_id=d.object_id " + _
                  " and d.CN_DOC_TIP_VEDOMOSTY = 13 and k.cn_doc_k_obozn='" + prmobject.Value("CN_DOC_K_OBOZN") + " " + "ÂÏ" + _
                  "' and k.revision_stg=1" + _
                  " and k.cn_kd_kod_roditel='" + CStr(kod_var) + "'" + _
                  "and (k.state=2 or k.state=0)"
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    SPEC.Open SPECsql
    If SPEC.RecordCount > 0 Then
        If SPEC.Fields("STATE").Value = 2 Then MsgBox "Ñäàéòå ðóêîâîäèòåëþ âçÿòóþ  íà ðåäàêòèðîâàíèå âåðñèþ ÑÏ!!!"
        If SPEC.Fields("STATE").Value = 0 Then MsgBox "Ñäàéòå ðóêîâîäèòåëþ âåðñèþ ÑÏ ó àâòîðà!!!"
        Unload Me
        Exit Sub
    End If
    SPEC.Close

'===============================================ãðóïïîâàÿ ÂÏ äëÿ èñïîëíåíèé====================================
        
    Dim i As Integer
    Rem íàõîæäåíèå ïîêóïíûõ èçäåëèé äëÿ êàæäîãî èñïîëíåíèÿ âûäåëåííîãî îáúåêòà
    Rem èñïîëüçóåòñÿ ðåêóðñèâíàÿ ôóíêöèÿ äëÿ íàõîæäåíèÿ âñåõ äåòåé âûäåëåííîãî îáúåêòà è âñåõ â íåãî âõîäÿùèõ
    Rem ðåçóëüòàòû ïîìåùàþòñÿ â òàáëèöó extentional.glavnaia
    For i = 0 To kolcount - 1
        'Âûçîâ ïðîöåäóð èç áàçû äàííûõ
        Set cmd = New ADODB.Command
        cmd.ActiveConnection = dc
        cmd.CommandText = "PROC_FIND_POKUPNYE" 'ÈÌß ÏÐÎÖÅÄÓÐÛ
        cmd.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
        cmd.Parameters.Append cmd.CreateParameter("in_ob", adInteger, adParamInput, 10, ispoln.Fields("object_id"))
        cmd.Parameters.Append cmd.CreateParameter("in_user", adInteger, adParamInput, 10, us)
        cmd.Parameters.Append cmd.CreateParameter("out_link", adInteger, adParamOutput, 10, link)
        cmd.Parameters.Append cmd.CreateParameter("out_obj", adInteger, adParamOutput, 10, obj)
        cmd.Parameters.Append cmd.CreateParameter("out_link_1", adInteger, adParamOutput, 10, link)
        cmd.Parameters.Append cmd.CreateParameter("out_obj_1", adInteger, adParamOutput, 10, obj)
        cmd.Execute
        ispoln.MoveNext
    Next i
'==========ïðàâèòü êîëâî!!!!!!!!!!!!!!!!!!!!!==============
    'ÏÎÈÑÊ ÎÁÙÈÕ ÄÀÍÍÛÕ
    'Ïîèñê  îáùèõ äàííûõ
    Rem âûáèðàþòñÿ âñå çíà÷åíèÿ èç extentional.glavnaia êðîìå ñàìîãî âûäåëåííîãî îáúåêòà (âñå äåòè) ñîîòâåòñòâóþùèå
    Rem âûäåëåííîìó îáúåêòó è ïîëüçîâàòåëþ âûáðàâøåìó îáúåêò è ïîìåùàþòñÿ â extentional.obshie
    Dim cm4 As ADODB.Command
    
    On Error GoTo ErrHa
     
    Set cm4 = New ADODB.Command
    cm4.ActiveConnection = dc
    cm4.CommandText = "PROC_FIND_OBSHIE_POK" 'ÈÌß ÏÐÎÖÅÄÓÐÛ
    cm4.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
    cm4.Parameters.Append cm4.CreateParameter("in_kol_count", adInteger, adParamInput, 10, kolcount)
    cm4.Parameters.Append cm4.CreateParameter("in_us", adInteger, adParamInput, 10, us)
    cm4.Execute
 

 
ErrHa:

    'Âîðîòûíöåâà Îáðàáîò÷èê îøèáîê! Åñëè çàïðîñ âûïîëíåí íå âåðíî.
    If Err.Number <> 0 Then

        ' Âîðîòûíöåâà. Âûâîä îøèáêè ïîëüçîâàòåëþ
        Select Case Err.Number
            Case 6
                MsgBox "Ó Âàñ îøèáêà !   " & Err.Description
                Resume Next
            Case 13
                MsgBox "Ãäå-òî íåñîîòâåòñòâèå òèïîâ   " & Err.Description
    '        Case -2147217913
    '            MsgBox "Â îäíîé èç ïîçèöèé âñòðåòèëèñü áóêâû! Ïðîâåðüòå âñå ïîçèöèè, ÷òîáû áûëè òîëüêî öèôðû!"
     '           Unload Me
     '           Exit Sub
            Case -2147217900
                MsgBox "Ê îäíîé èç äåòàëåé ïðèâÿçàíî íåäîïóñòèìîå êîëè÷åñòâî îáúåêòîâ. Íàïðèìåð: 2 ïîêóïíûõ èçäåëèÿ èëè ÷åðòåæ CATIA è ïîêóïíîå èçäåëèå. Ïðîâåðüòå âñå îáúåêòû!"
                Unload Me
                Exit Sub
            Case Else
                MsgBox "Îøèáêà!   " & Err.Description
                Unload Me
                Exit Sub
            End Select
    End If
rr:
    
    
    ispoln2 = Val(prmobject.ObjectId)

Rem ñîçäàíèå ïîëÿ òàáëèöû äëÿ âûâîäà ïåðâè÷íîé ïðèìåíÿåìîñòè ñáîðî÷íîé åäèíèöû ÂÀV 21/07/2010
    Dim PerPrim As ADODB.Recordset
    Set PerPrim = New ADODB.Recordset
    PerPrim.ActiveConnection = dc
    With PerPrim
        PerPrimsql = "select cp.CN_UM from extentional.glavnaia g, tn_catia_product cp where  " + _
                     "g.object_id=cp.object_id and g.users_object=" + CStr(us) + _
                     "and (g.cn_doc_k_obozn <> ' ' or g.cn_doc_k_obozn is not null)"
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    PerPrim.Open PerPrimsql
        
    Rem ðàáîòà ñ îêíîì âèçóàëèçàöèè âåäîìîñòè
    
    Rem ñîçäàåòñÿ òàáëèöà POK â êîòîðóþ âûáèðàþòñÿ âñå çíà÷åíèÿ òàáëèöû extentional.obshie ñîîòâåòñòâóþùèå
    Rem ïîêóïíûì èçäåëèÿì âûáðàííîãî ïîëüçîâàòåëåì îáúåêòà
    Dim POK As ADODB.Recordset
    Set POK = New ADODB.Recordset
    POK.ActiveConnection = dc
    With POK
        POKsql = "select * from extentional.obshie g  where  " + _
                 "g.users_object=" + CStr(us)
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    POK.Open POKsql
    Rem ðàáîòà ñ îêíîì âèçóàëèçàöèè âåäîìîñòè
    If POK.RecordCount > 0 Then
        frmProgrBar.Check1.Value = 1
        frmProgrBar.Check2.SetFocus
        frmProgrBar.Check2.FontBold = True
        frmProgrBar.ProgressBar1.Value = 25
        DoEvents

        Dim Sp1Path As String
        Dim Sp2Path As String
        frmProgrBar.Check2.Value = 1
        frmProgrBar.Check2.SetFocus
        frmProgrBar.Check2.FontBold = True
        frmProgrBar.ProgressBar1.Value = 50
        DoEvents
    
        'çàãðóæàåì øàáëîíû excel'
        Rem Âèä øàáëîíîâ çàâèñèò îò òîãî áûë ëè âûäåëåí ïóíêò "ñâîäíàÿ âåäîìîñòü ïî ïëàòåæíûì óçëàì"
        If frmMain.Check1 = 1 Then
            Sp1Path = sRet + "\Êîíñòð_ÂÏ_ÏëàòåæíûåÓçëû_Òÿæìàø_ëèñò11.xlt"
            Sp2Path = sRet + "\Êîíñòð_ÂÏ_ÏëàòåæíûåÓçëû_Òÿæìàø_ëèñò22.xlt"
        Else
        'sRet = "C:\Users\32755\Desktop\VP"
            Sp1Path = sRet + "\Êîíñòð_ÂÏ_Òÿæìàø_ëèñò11.xlt"
            Sp2Path = sRet + "\Êîíñòð_ÂÏ_Òÿæìàø_ëèñò22.xlt"
        End If
   
        Rem àññîöèàöèÿ ñ ïðèëîæåíèåì Excel, îòêðûòèå õðàíèìûõ íà Smartas øàáëîíîâ
        Set Excel = CreateObject("excel.application")
        Excel.Workbooks.Open FileName:=Sp1Path
        Excel.Workbooks.Open FileName:=Sp2Path
        Excel.Workbooks(1).Activate

        nl = 2
        sh = 2
        nlist = 1
        ns = CDbl(frmMain.Text1.Text)
        
      
'Äëÿ âèäèìîñòè Excelÿ
        If SmSession.UserMetaInfo.user.Data.ValueAsString("LOGIN") = "ÁåëàøåâÀÂ" _
        Or SmSession.UserMetaInfo.user.Data.ValueAsString("LOGIN") = "ÂîðîòûíöåâàÀÞ" _
        Or SmSession.UserMetaInfo.user.Data.ValueAsString("LOGIN") = "ÏÿòàêîâÄÑ" _
        Or SmSession.UserMetaInfo.user.Data.ValueAsString("LOGIN") = "ÑèçàíîâàÅÈ" _
        Or SmSession.UserMetaInfo.user.Data.ValueAsString("LOGIN") = "×âàíîâàÎÞ" _
        Then Excel.Visible = True
      
        'ïå÷àòü ïðî÷èõ èçäåëèé
        Rem ïåðåäà÷à óïðàâëåíèÿ ôóíêöèè PrintPOK
        ret = printPOK
  
        Rem åñëè áûëà âûáðàíà ãðóïïîâàÿ âåäîìîñòü
        If Option2.Value = True Then        '========================ÈÑÏÎËÍÅÍÈß===========================
            Set ispoln_1 = New ADODB.Recordset
            ispoln_1.ActiveConnection = dc
            sqlisp1 = "select * from extentional.glavnaia g" + _
                      " where g.class_id = 1576 and g.users_object =" + CStr(us) + _
                      " and (g.cn_doc_k_obozn like '" + obozn + "'||'-%' or  g.cn_doc_k_obozn  = '" + obozn + "' ) order by g.cn_doc_k_obozn"
            With ispoln_1
                .CursorLocation = adUseServer
                .CursorType = adOpenStatic
                .LockType = adLockOptimistic
            End With
            ispoln_1.Open sqlisp1
           
            Excel.Range("P" & Format(r) & ":CC" & Format(r)).Select 'h-p
            Excel.Selection.Merge
            Excel.Selection.HorizontalAlignment = -4108
            Excel.Selection.Font.Underline = 2
            Excel.Range("AX" & Format(r)).Select
            Excel.Selection.Font.Size = 14
            Excel.ActiveCell.FormulaR1C1 = "Ïåðåìåííûå äàííûå äëÿ èñïîëíåíèé:"
            nrow
        
            Dim s As Integer
            For s = 0 To ispoln_1.RecordCount - 1
                nrow
                Excel.Range("AX" & Format(r)).Select
                Excel.Selection.Font.Underline = 2
                Excel.Selection.Font.Italic = True
                Excel.Selection.Font.Bold = True
                Excel.ActiveCell.FormulaR1C1 = ispoln_1.Fields("CN_DOC_K_OBOZN")
                nrow
     
                Set delTb = New ADODB.Command
                delTb.ActiveConnection = dc
                delTb.CommandText = "delete from extentional.obshie g where g.users_object=" + CStr(us)
                delTb.Execute
                ispoln2 = Val(ispoln_1.Fields("OBJECT_ID"))
     
                'Ïåðåìåííûå äàííûå
                Dim cm8 As ADODB.Command
                Set cm8 = New ADODB.Command
                cm8.ActiveConnection = dc
                cm8.CommandText = "FIND_DAN_ISPOL_POK" 'ÈÌß ÏÐÎÖÅÄÓÐÛ
                cm8.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
                cm8.Parameters.Append cm8.CreateParameter("in_kol_count", adInteger, adParamInput, 10, kolcount)
                cm8.Parameters.Append cm8.CreateParameter("in_isp_obj", adInteger, adParamInput, 10, ispoln_1.Fields("OBJECT_ID"))
                cm8.Parameters.Append cm8.CreateParameter("in_us", adInteger, adParamInput, 10, us)
                cm8.Execute
                ret = printPOK
                ispoln_1.MoveNext
            Next s
        End If
          
'=======================================================================================
        Dim SE As New ADODB.Recordset
        Set SE = New ADODB.Recordset
        Rem ïîèñê äåòåé âûäåëåííîãî îáúåêòà ñ CLASS_ID2 1576 (catia product) è ?????t.cn_not_use_vp_kd=-1?????
        SE.ActiveConnection = dc
        With SE
            Sesql = "select * " + _
                    " from konstr__tree t, tn_konstr_doc tn " + _
                    " Where t.object_id2 = tn.object_id " + _
                    " and t.OBJECT_ID1= " + CStr(prmobject.ObjectId) + _
                    " and t.CLASS_ID2=1576 and t.cn_not_use_vp_kd=-1  and tn.revision_stg=1"
            .CursorLocation = adUseServer
            .CursorType = adOpenStatic
            .LockType = adLockOptimistic
        End With
        SE.Open Sesql
        For t = 0 To SE.RecordCount - 1
            If SE.RecordCount > 0 Then
                nrow
                Excel.Range("H" & Format(r) & ":EF" & Format(r)).Select 'h-p
                Excel.Selection.Merge
                Excel.ActiveCell.FormulaR1C1 = SE.Fields("CN_DOC_K_NAIMENOVANIE") + " " + _
                SE.Fields("CN_DOC_K_OBOZN") + " ÂÏ"
            End If
            SE.MoveNext
        Next t
       
 '=====================================================================================
        If frmMain.Text2.Text <> "" Then
            For i = 1 To CDbl(frmMain.Text2.Text) - 1
                nrow
            Next i
        End If

        'ÇÀÏÎËÍßÅÌ ÎÑÍÎÂÍÓÞ ÍÀÄÏÈÑÜ
        Dim ns_h As Integer
        ns_h = 1
        Dim nch As String
        nch = ""
        If Check3.Value = 1 Then
        Excel.Range("DX" & Format(36)).Select             ' Sei  ïðîñòàâëÿåòñÿ ëèòåðà ïî çàïðîñó Ñèçîâîé
        Excel.ActiveCell.FormulaR1C1 = "È"
        End If
        
        For i = 1 To nlist
            If ns_h = 1 Then
                Excel.Range("A1:EO5000").Select        'KAA 11.08.09 óáðàë æèðíûé øðèôò
                Excel.Selection.Font.Bold = False
     
                If PerPrim.RecordCount > 0 Then
                    Excel.Range("CY" & Format(ns_h + 35)).Select 'ïåðâè÷íàÿ ïðèìåíÿåìîñòü ÂÀV 21/07/2010
                    Excel.ActiveCell.FormulaR1C1 = PerPrim.Fields("CN_UM")
                End If
                
                Excel.Range("CY" & Format(ns_h + 31)).Select 'îáîçíà÷åíèå
                Excel.ActiveCell.FormulaR1C1 = prmobject.Data.Value("CN_DOC_K_OBOZN") + " ÂÏ"
     
                Excel.Range("ED" & Format(ns_h + 35)).Select 'òåêóùèé ëèñò
                Excel.ActiveCell.FormulaR1C1 = CStr(i)

                Excel.Range("EJ" & Format(ns_h + 35)).Select 'îáùåå êîëè÷åñòâî ëèñòîâ
                Excel.ActiveCell.FormulaR1C1 = CStr(nlist)
     
                Excel.Range("CY" & Format(ns_h + 34)).Select 'Íàèìåíîâàíèå
                Excel.ActiveCell.FormulaR1C1 = prmobject.Data.Value("CN_DOC_K_NAIMENOVANIE")

                Excel.Range("CH" & Format(ns_h + 34)).Select
                Excel.ActiveCell.FormulaR1C1 = Combo1.Text 'Ðàçðàáîòàë
    
                Excel.Range("CH" & Format(ns_h + 35)).Select
                Excel.ActiveCell.FormulaR1C1 = Combo2.Text ' Ïðîâåðèë
    
                Excel.Range("CH" & Format(ns_h + 36)).Select
                Excel.ActiveCell.FormulaR1C1 = Combo3.Text ' Íà÷.áþðî
    
                Excel.Range("CH" & Format(ns_h + 37)).Select
                Excel.ActiveCell.FormulaR1C1 = Combo4.Text ' Í.êîíòðîëü
    
                Excel.Range("CH" & Format(ns_h + 38)).Select
                Excel.ActiveCell.FormulaR1C1 = Combo5.Text ' Óòâåðäèë
     
                Dim user_main As ISmObject
                Set user_main = SmSession.ObjectStore.RetrieveObject(3, us)
                
Rem------------------------------------BAV âûâîä ÑÃÒÇ äëÿ 57 ðîëè-------------------------------------------
                If MAIN_SECURE_USER_ROLE = 57 Then
                    Excel.Range("DX" & Format(ns_h + 36)).Select 'ôèðìà
                    Excel.Selection.Font.Size = 12
                    Dim h As String
                    h = "ÇÀÎ " + Chr(34) + "ÑÃÒÇ" + Chr(34)
                    Excel.ActiveCell.FormulaR1C1 = h
                End If
Rem-----------------------------------------------------------------------------------------------------

            Else
                
     
               ' If i < 3 Then
                Excel.Range("CZ" & Format(ns_h + 33)).Select 'îáîçíà÷åíèå
                Excel.ActiveCell.FormulaR1C1 = prmobject.Data.Value("CN_DOC_K_OBOZN") + " ÂÏ"
                Excel.Range("EL" & Format(ns_h + 34)).Select 'òåêóùèé ëèñò
                Excel.ActiveCell.FormulaR1C1 = CStr(i)
              '  Else
              '  Excel.Range("CZ" & Format(ns_h + 38)).Select 'îáîçíà÷åíèå
              '  Excel.ActiveCell.FormulaR1C1 = PRMObject.Data.Value("CN_DOC_K_OBOZN") + " ÂÏ"
              '
              '  Excel.Range("EL" & Format(ns_h + 39)).Select 'òåêóùèé ëèñò
              '  Excel.ActiveCell.FormulaR1C1 = CStr(i)
              '  End If
                
            End If
            frmProgrBar.Check3.Value = 1
            frmProgrBar.Check3.SetFocus
            frmProgrBar.Check3.FontBold = True
            frmProgrBar.ProgressBar1.Value = 75
            DoEvents
            If ns_h = 1 Then
                ns_h = ns_h + 39
            Else
                ns_h = ns_h + 36
            End If
        Next i
    
        'Äàëüøå ñîçäàâàòü îáúåêò ñïåöèôèêàöèè ïîìåùàòü â ïàïêó è óòâåðæäàòü
        'Îáîçíà÷åíèå ôàéëà è çàãðóçêà â ðàáî÷óþ ïàïêó Smarteam
        Dim ffn As String
        ffn = prmobject.Data.ValueAsString("CN_DOC_K_OBOZN") + " ÂÏ" + _
              "_" + CStr(Date) + "_" + CStr(Format(Time, "hh÷mmìèíssñåê"))
        ffn = Replace(ffn, "/", "_")
        ffn = Replace(ffn, """", "_")
        ffn = ffn + ".xls"
        
        Dim WorkDir As String
        WorkDir = SmSession.Config.HomeDirectory & "\Work\"
        
Rem---------------------BAV äîáàâèë ñîõðàíåíèå êàê äîêóìåíò Åxcel 1997-2003-----------------------------------------
        Select Case Excel.Application.Version
            Case "10.0", "11.0": Excel.ActiveWorkbook.SaveAs WorkDir + ffn
            Case "12.0", "14.0": Excel.ActiveWorkbook.SaveAs WorkDir + ffn, FileFormat:=xlExcel8
            Case Else
                MsgBox ("Âíèìàíèå âåäîìîñòü íå ñîõðàíèëàñü!!! Ñîîáùèòå ðàçðàáîò÷èêàì " + _
                "ïî òåëåôîíó 84-94 âàøó âåðñèþ Excel è ýòîò êîä: " + CStr(Excel.Application.Version))
        End Select
Rem-----------------------------------------------------------------------------------------------------------------
        
        Dim clas As Integer
        Dim object As Integer
        Dim vedpok As ISmObject
        'èùåì ïîñëåäíþþ âåðñèþ îáúåêòà âåäîìîñòè
        Dim Vedp As ADODB.Recordset
        Set Vedp = New ADODB.Recordset
        Set Vedp.ActiveConnection = dc
        Vedpsql = "select * from tn_konstr_doc k, DOC_VED_KONSTR d  where k.class_id=2734 " + _
                  " and k.object_id=d.object_id " + _
                  " and d.CN_DOC_TIP_VEDOMOSTY = 13 and k.cn_doc_k_obozn='" + prmobject.Value("CN_DOC_K_OBOZN") + " " + "ÂÏ" + _
                  "' and k.revision_stg=1" + _
                  " and k.cn_kd_kod_roditel='" + CStr(kod_var) + "'"
        With Vedp
            .CursorLocation = adUseServer
            .CursorType = adOpenStatic
            .LockType = adLockOptimistic
        End With
        Vedp.Open Vedpsql
        If Vedp.RecordCount > 0 Then
            Dim OldVedpok As ISmObject
            Set OldVedpok = SmSession.ObjectStore.RetrieveObject(Vedp.Fields("CLASS_ID").Value, Vedp.Fields("OBJECT_ID").Value)
            Set vedpok = SmSession.ObjectStore.NewObject(2734)
            If MAIN_SECURE_USER_ROLE = 57 Then
                vedpok.Value("CN_SECURE_USER_ROLE") = 57
            Else
                vedpok.Value("CN_SECURE_USER_ROLE") = 0
            End If
            vedpok.Value("CN_DOC_K_OBOZN") = OldVedpok.Value("CN_DOC_K_OBOZN")
            vedpok.Value("CN_DOC_K_NAIMENOVANIE") = prmobject.Data.ValueAsString("CN_DOC_K_NAIMENOVANIE")
            vedpok.Value("CN_KD_KOD_RODITEL") = prmobject.Data.ValueAsString("CN_KD_KOD_RODITEL")
            vedpok.Value("CN_DOC_TIP_VEDOMOSTY") = 13
            Dim sequence As ISmSequence
            Set sequence = SmSession.ObjectStore.Sequences.ItemByAttribute(OldVedpok.SmClass.Attributes.ItemByName("REVISION"))
            vedpok.Value("REVISION") = sequence.IncrementValue(OldVedpok.Value("REVISION"), False)
            vedpok.Value("REVISION_STG") = 1
            OldVedpok.Value("REVISION_STG") = 0
            OldVedpok.Update
            vedpok.Value("DIRECTORY") = WorkDir
            vedpok.Value("FILE_NAME") = ffn
            Set Lookup = SmSession.ObjectStore.GetLookUpList(11).ItemByUniqueName("Microsoft Excel")
            vedpok.Value("FILE_TYPE") = Lookup.ID
            vedpok.InsertEx behavior
            'Åñëè îáúåêò âåäîìîñòè íå íàéäåí, ñîçäàåì íîâûé îáúåêò
        Else
            Set vedpok = SmSession.ObjectStore.NewObject(2734)
            If MAIN_SECURE_USER_ROLE = 57 Then
                vedpok.Value("CN_SECURE_USER_ROLE") = 57
            Else
                vedpok.Value("CN_SECURE_USER_ROLE") = 0
            End If
            vedpok.Value("CN_DOC_K_OBOZN") = prmobject.Value("CN_DOC_K_OBOZN") + " " + "ÂÏ"
            vedpok.Value("CN_DOC_K_NAIMENOVANIE") = prmobject.Data.ValueAsString("CN_DOC_K_NAIMENOVANIE")
            vedpok.Value("CN_KD_KOD_RODITEL") = prmobject.Data.ValueAsString("CN_KD_KOD_RODITEL")
            vedpok.Value("CN_DOC_TIP_VEDOMOSTY") = 13
            vedpok.Value("DIRECTORY") = WorkDir
            vedpok.Value("FILE_NAME") = ffn
            Set Lookup = SmSession.ObjectStore.GetLookUpList(11).ItemByUniqueName("Microsoft Excel")
            vedpok.Value("FILE_TYPE") = Lookup.ID
            vedpok.InsertEx behavior
        End If
        'Èùåì ïàïêó êîíñòðóêòîðà äëÿ ñîõðàíåíèÿ îáúåêòà âåäîìîñòè
        Dim cm2 As ADODB.Command
        Set cm2 = New ADODB.Command
        cm2.ActiveConnection = dc
        cm2.CommandText = "FIND_PAPKA" 'ÈÌß ÏÐÎÖÅÄÓÐÛ
        cm2.Parameters.Append cm2.CreateParameter("In_obozn_doc ", adChar, adParamInput, 255, prmobject.Data.ValueAsString("CN_DOC_K_OBOZN"))
        cm2.Parameters.Append cm2.CreateParameter("Out_Class_Id ", adInteger, adParamOutput, 10, clas)
        cm2.Parameters.Append cm2.CreateParameter("Out_Object_Id ", adInteger, adParamOutput, 10, object)
        If kod_var = " " Then
            cm2.Parameters.Append cm2.CreateParameter("in_kod_var", adChar, adParamInput, 255, "null")
        Else
            cm2.Parameters.Append cm2.CreateParameter("in_kod_var", adChar, adParamInput, 255, kod_var)
        End If
        cm2.Execute
        If cm2(1).Value <> " " Then
            'Âñòàâëÿåì âåäîìîñòü â ïàïêó
            Dim pap As ISmObject
            Set pap = SmSession.ObjectStore.RetrieveObject(cm2(1).Value, cm2(2).Value)
            Set behavior = pap.ObjectStore.DefaultBehavior.Clone
            behavior.ConfirmOperations = coYesToAll
            Set LinkVed = SmSession.ObjectStore.NewHierLink(127, cm2(1).Value, cm2(2).Value, vedpok.ClassId, vedpok.ObjectId)
            LinkVed.InsertEx behavior
            Excel.ScreenUpdating = True
            Excel.Visible = True
            Dim ROD As ISmObject
            Set ROD = SmSession.ObjectStore.RetrieveObject(prmobject.ClassId, prmobject.ObjectId)
            Dim behavior1 As ISmBehavior
            Set behavior1 = ROD.ObjectStore.DefaultBehavior.Clone
            behavior1.ConfirmOperations = coYesToAll
            Set LinkKD = SmSession.ObjectStore.NewHierLink(127, prmobject.ClassId, prmobject.ObjectId, cm2(1).Value, cm2(2).Value)
            If LinkKD.Count < 0 Then
                LinkKD.InsertEx behavior1
                Excel.ScreenUpdating = True
                Excel.Visible = True
            End If
            Set Excel = Nothing
        Else
            'ñîçäàåì  îáúåêò ïàïêè
            Dim KDPapka As ISmObject
            Set KDPapka = SmSession.ObjectStore.NewObject(2740)
            If MAIN_SECURE_USER_ROLE = 57 Then
                KDPapka.Value("CN_SECURE_USER_ROLE") = 57
            Else
                KDPapka.Value("CN_SECURE_USER_ROLE") = 0
            End If
            KDPapka.Value("CN_DOC_K_OBOZN") = prmobject.Data.Value("CN_DOC_K_OBOZN") + ">>Doc"
            KDPapka.Value("CN_DOC_K_NAIMENOVANIE") = prmobject.Data.ValueAsString("CN_DOC_K_NAIMENOVANIE")
            KDPapka.Value("CN_KD_KOD_RODITEL") = prmobject.Data.ValueAsString("CN_KD_KOD_RODITEL")
            KDPapka.Insert
            Set behavior = KDPapka.ObjectStore.DefaultBehavior.Clone
            behavior.ConfirmOperations = coYesToAll
            Set LinkVed = SmSession.ObjectStore.NewHierLink(127, KDPapka.ClassId, KDPapka.ObjectId, vedpok.ClassId, vedpok.ObjectId)
            LinkVed.InsertEx behavior
            Excel.ScreenUpdating = True
            Excel.Visible = True

            frmProgrBar.Check4.Value = 1
            frmProgrBar.Check4.SetFocus
            frmProgrBar.Check4.FontBold = True
            frmProgrBar.ProgressBar1.Value = 90
            DoEvents
            Set ROD = SmSession.ObjectStore.RetrieveObject(prmobject.ClassId, prmobject.ObjectId)
            Set behavior1 = ROD.ObjectStore.DefaultBehavior.Clone
            behavior1.ConfirmOperations = coYesToAll
            Set LinkKD = SmSession.ObjectStore.NewHierLink(127, prmobject.ClassId, prmobject.ObjectId, KDPapka.ClassId, KDPapka.ObjectId)
            LinkKD.InsertEx behavior1
            Excel.ScreenUpdating = True
            Excel.Visible = True
            Set Excel = Nothing
        End If
        'Óäàëÿåì äàííûå èç âðåìåííîé òàáëèöû
        Set delTb = New ADODB.Command
        delTb.ActiveConnection = dc
        delTb.CommandText = "delete from extentional.glavnaia g where g.users_object=" + CStr(us)
        delTb.Execute
        Set delTb1 = New ADODB.Command
        delTb1.ActiveConnection = dc
        delTb1.CommandText = "delete from extentional.child g where g.user_ob=" + CStr(us)
        delTb1.Execute
        frmProgrBar.ProgressBar1.Value = 100
        frmProgrBar.SetFocus
        frmProgrBar.Check4.Value = 1
        frmProgrBar.Check4.FontBold = True
        frmProgrBar.ProgressBar1.Visible = False
        frmProgrBar.Label1.Visible = True
        frmProgrBar.Frame1.Enabled = False
        DoEvents
    Else
        MsgBox "Ïîêóïíûõ èçäåëèé íå íàéäåíî!"
        Unload Me
        Unload frmProgrBar
    End If
End Sub
'***************************
'Ïå÷àòü ïîêóïíûõ èçäåëèé
'***************************
Function printPOK() As Integer
    Rem êîïèðîâàíèå çíà÷åíèé ñîîòâåòñòâóþùèõ ïîêóïíûì èçäåëèÿì âõîäÿùèì â âûáðàííûé ïîëüçîâàòåëåì îáúåêò èç òàáëèöû
    Rem extentional.obshie â Recordset glav è óïîðÿäî÷èâàíèå ïî íàçâàíèþ ïîêóïíîãî èçäåëèÿ
 If Check4.Value <> 1 Then
    Dim glav As ADODB.Recordset
    Set glav = New ADODB.Recordset
    glav.ActiveConnection = dc
    With glav ' íå âíåñåíû äàíûå â îáùèå
        glavsql = "select g.*, REPLACE(to_char(g.cn_sostav),chr(13)||chr(10),'') as cn_sostavv from extentional.obshie g where" + _
                  " g.users_object=" + CStr(us) + _
                  "order by g.cn_obozn_stand"
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    glav.Open glavsql
    
    Else
        Set glav = New ADODB.Recordset
        glav.ActiveConnection = dc
        With glav
             glavsql = " select e.object_id2, e.class_id2, r.cn_doc_k_obozn, r.cn_doc_k_naimenovanie" + _
                       " from konstr__tree e,  tn_konstr_doc r" + _
                       " where e.OBJECT_ID1 in (select r.object_id from tn_konstr_doc r, DOC_PAPKA tl, konstr__tree ty" + _
                       " where  ty.object_id1 in (select r.object_id from tn_konstr_doc r, konstr__tree tl" + _
                       " Where tl.OBJECT_ID1 = " + CStr(prmobject.ObjectId) + _
                       " and r.object_id=tl.OBJECT_ID2" + _
                       " and r.revision_stg=1)" + _
                       " and r.object_id=tl.object_id" + _
                       " and ty.object_id2=tl.object_id)" + _
                       " and r.object_id=e.OBJECT_ID2" + _
                       " AND r.cn_doc_k_obozn like '%ÂÏ%'" + _
                       " and r.revision_stg=1 "
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        End With
             glav.Open glavsql

 End If
    
If Check4.Value <> 1 Then
    If glav.RecordCount > 0 Then
       Rem íàõîæäåíèå ïîêóïíûõ èçäåëèé äëÿ âûäåëåííîãî îáúåêòà
       Rem èñïîëüçóåòñÿ ðåêóðñèâíàÿ ôóíêöèÿ äëÿ íàõîæäåíèÿ âñåõ äåòåé âûäåëåííîãî îáúåêòà è âñåõ â íåãî âõîäÿùèõ
       Rem ðåçóëüòàòû ïîìåùàþòñÿ â òàáëèöó extentional.child
        Dim cm As ADODB.Command
       Set cm = New ADODB.Command
           cm.ActiveConnection = dc
           cm.CommandText = "CHILD_KD" 'ÈÌß ÏÐÎÖÅÄÓÐÛ
           cm.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
           cm.Parameters.Append cm.CreateParameter("in_ob", adInteger, adParamInput, 10, ispoln2)
           cm.Parameters.Append cm.CreateParameter("in_user", adInteger, adParamInput, 10, us)
           cm.Parameters.Append cm.CreateParameter("out_kol", adInteger, adParamOutput, 10, kol_rod)
           cm.Execute
           Rem ïåðåáîð çíà÷åíèé recordset glav
        While Not glav.EOF
            
Rem------------------------------------------------------------------------------------------------------------------
            Rem åñëè êóðñîð â êîíöå ñòðîêè è òåêñò íå ïîìåùàåòñÿ, òî âñòàâèòü äâå íîâûå ñòðîêè
           ' If (ns >= 24 And nlist = 1) Or _
            '   (ns >= 28 And nlist > 1) Then  'And Len(glav.Fields("cn_obozn_stand").Value + glav.Fields("cn_dlina_pi")) > 30
                                             'And Len(glav.Fields("cn_obozn_stand").Value + glav.Fields("cn_dlina_pi")) > 50
            '    nrow
            '    nrow
           ' End If
            Dim t As Integer
            Dim kol_st, st, post_st As Integer        ' äëÿ ðåãóëèðîâàíèÿ âûâîäà áëîêà â íàèìåíîâàíèå
            Dim nss As Integer
            If glav.Fields("class_id") = 1576 Then
                Excel.Range("H" & Format(r)).Select
                Addnrow2 glav.Fields("cn_doc_k_obozn").Value, "H", "", 0, 28
               
                If glav.Fields("CN_ED_IZM_MASSi").Value <> 7 Then
                    Excel.Range("EF" & Format(w)).Select
                    Excel.ActiveCell.FormulaR1C1 = glav.Fields("CN_MASS").Value + _
                    edin(glav.Fields("CN_ED_IZM_MASSi").Value)
                Else
                
                    Excel.Range("EF" & Format(w)).Select
                    Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_mass").Value
                End If
                q = r
                w = r
            Else
                If glav.Fields("OBJECT_STAND") <> " " Or glav.Fields("OBJECT_STAND") <> Null Then
                   
                    Rem äîáàâëåíèå íîâîé ñòðîêè â îò÷åò
                    nrow
                    Rem çàïîìèíàíèå ïåðâîé ñòðîêè ïðè ââîäå íàèìåíîâàíèÿ èñïîëüçóåòñÿ äëÿ âûâîäà â ãðàôû êîëè÷åñòâî
                    q = r
                    Rem çàïîìèíàíèå ïåðâîé ñòðîêè ïðè ââîäå íàèìåíîâàíèÿ äëÿ ïîñëåäóþùåãî ââîäà â ãðàôû äàííîãî íàèìåíîâàíèÿ
                    w = r
Rem ////////////////////////////////////////////////////////////////////////////
Rem add èíêðåìåíòèðóåòñÿ â ïðîöåäóðå addnrow2 è çàòåì íèãäå íå èñïîëüçóåòñÿ íå èñïîëüçóåòñÿ
                    add = 0
                    nss = ns
                    Excel.Range("H" & Format(r)).Select
                    Rem ïðîöåäóðà äîáàâëåíèÿ è ðàçáèâêè äëèííûõ ñòðîê (ñòðîêà, íà÷àëî äèàïàçîíà, êîíåö äèàïàçîíà, óêàçàòåëü íà æèðíûé øðèôò, äîïóñòèìàÿ äëèíà ñòðîêè)
                    
                  '/  MsgBox Mid(glav.Fields("cn_primech").Value, 1, InStr(1, glav.Fields("cn_primech").Value, " "))
                  '/  MsgBox Mid(glav.Fields("cn_primech").Value, 1, InStr(1, glav.Fields("cn_primech").Value, " "))
                    
Rem-----------------------------------BAV Âûâîä * íà îáîçíà÷åíèå ïðè âûâîäå ïðèìå÷àíèÿ--------------------------------
                    If glav.Fields("cn_primech").Value <> " " And InStr(glav.Fields("CN_PRIMECH").Value, "$") = 0 Then
                        Addnrow2 glav.Fields("cn_obozn_stand").Value + Mid(glav.Fields("cn_primech"), 1, InStr(1, glav.Fields("cn_primech"), " ")) + glav.Fields("cn_dlina_pi").Value, "H", "", 0, 28
                        If Len(glav.Fields("cn_sostavv")) <> 8 Then
                            nrow
                            Excel.Range("H" & Format(r)).Select
                            Addnrow2 glav.Fields("cn_sostavv").Value, "H", "", 0, 25
                        End If
                    Else
                     ''''SEI
                    C = 0
                    If glav.Fields("cn_shag_rezby") <> " " Then C = 1
                    
                     
                    post_st = Fix(Len(Format$(glav.Fields("cn_teh_marshrut").Value)) / 20) + 1
                    If Len(glav.Fields("cn_sostavv")) > 3 Then
                    kol_st = (Fix(Len(Format$(glav.Fields("cn_obozn_stand").Value + glav.Fields("cn_dlina_pi").Value)) / 28) + 1 + C) + _
                   (Fix((Len(glav.Fields("cn_sostavv").Value) / 20) + 2) + 1)
                    Else
                     kol_st = Fix(Len(Format$(glav.Fields("cn_obozn_stand").Value + glav.Fields("cn_dlina_pi").Value)) / 28) + 1 + C
                    End If
                   ' MsgBox kol_st
                    If nlist = 1 Then
                    st = 24 - ns
                    Else
                    st = 29 - ns
                    End If
                    
                    If kol_st >= st Or post_st > st Then
                         i = 0
                    For i = 0 To st - 1
                         nrow
                    Next i
                    End If
                ''''''''''''''''''''''''''''''''''''''''''''''
                     Rem çàïîìèíàíèå ïåðâîé ñòðîêè ïðè ââîäå íàèìåíîâàíèÿ èñïîëüçóåòñÿ äëÿ âûâîäà â ãðàôû êîëè÷åñòâî
                    q = r
                    Rem çàïîìèíàíèå ïåðâîé ñòðîêè ïðè ââîäå íàèìåíîâàíèÿ äëÿ ïîñëåäóþùåãî ââîäà â ãðàôû äàííîãî íàèìåíîâàíèÿ
                    w = r
                        Addnrow2 glav.Fields("cn_obozn_stand").Value + glav.Fields("cn_dlina_pi").Value, "H", "", 0, 28
                          Rem äîáàâëåíèå ñòðîê "àðò..." "êàò..."
                          Rem SEI ïîìåíÿëà âûâîä àðò. ïî çàÿâêå Ñèçîâîé
                    If glav.Fields("cn_shag_rezby") <> " " Then
                        nrow
                        Excel.Range("H" & Format(r)).Select
                        Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_shag_rezby").Value
                    End If
                    
                        If Len(glav.Fields("cn_sostavv")) > 3 Then
                            'MsgBox glav.Fields("cn_sostav")
                            nrow
                            Excel.Range("H" & Format(r)).Select
                         
                            Addnrow2 glav.Fields("cn_sostavv").Value, "H", "", 0, 20
                        End If
                       
                    End If
            
Rem--------------------------------Âûâîä ïðèìå÷àíèÿ BAV, ×ÎÞ 21.07.2010----------------------------------------------
            If glav.Fields("CN_PRIMECH").Value <> " " And InStr(glav.Fields("CN_PRIMECH").Value, "$") = 0 Then
               If nlist = 1 Then
                  p = 32 - ns
                  Else
                      p = 29 - ns
               End If
              If glav.Fields("CN_PRIMECH").Value = prim_z Then
                 Else
                     Excel.Range("E" & Format(r + p)).Select
                     Excel.Selection.HorizontalAlignment = xlLeft
                     Excel.Selection.Font.Name = "Gost Type B"
                     Excel.Selection.Font.Size = 12
                     Excel.Selection.Font.Italic = True
                     prim_z = glav.Fields("CN_PRIMECH").Value
                     prim_z2 = prim_z2 + " " + prim_z
               Dim prov As Integer
                     prov = InStr(1, prim_z2, prim_z)
                     If prov <> 1 Then
                        If Excel.ActiveCell.FormulaR1C1 <> "" Then
                           Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + Chr(10) + prim_z
                           Else
                               Excel.ActiveCell.FormulaR1C1 = prim_z
                        End If
                     End If
              End If
            End If
Rem-------------------------------------------------------------------------------------------------------------------
                   Rem SEI ïîìåíÿëà âûâîä àðò. ïî çàÿâêå Ñèçîâîé (Áûë çäåñü)
                  
                    
                    t = r
                    ob = r
                    If glav.Fields("cn_kod_okp").Value <> " " Then
                        Excel.Range("AF" & Format(r - ob)).Select
                        Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_kod_okp").Value
                    End If
                    If glav.Fields("CN_CATALOG_POK").Value <> " " Then
                        If InStr(1, glav.Fields("CN_CATALOG_POK"), "Êàòàëîã") <= 0 Then
                            Excel.Range("AV" & Format(w)).Select
                            Excel.ActiveCell.FormulaR1C1 = "Êàòàëîã" + " " + glav.Fields("CN_CATALOG_POK").Value
                        Else
                            Excel.Range("AV" & Format(w)).Select
                            Excel.ActiveCell.FormulaR1C1 = glav.Fields("CN_CATALOG_POK").Value
                        End If
                    Else
                        Rem ââîä îáîçíà÷åíèÿ äîêóìåíòà íà ïîñòàâêó
                        Excel.Range("AV" & Format(w)).Select 'r - add
                        Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_nomer_sklada_i_data").Value
                    End If
                Else
                    If glav.Fields("cn_kod_mater") <> " " Then
                        nrow
                        Dim edinizm As String
                      '  Dim kod As Integer
                        If glav.Fields("ed_izm_proc") <> Null Then
                            edinizm = edin(glav.Fields("ed_izm_proc"))
                            ' kod = glav.Fields("ed_izm_proc")
                        End If
                    
                    post_st = Fix((Len(glav.Fields("cn_teh_marshrut").Value) + 2) / 20) + 1
                     
                    kol_st = Fix(Len(Format$(glav.Fields("cn_obozn_stand").Value + " " + glav.Fields("cn_osn_razm").Value + " " + _
                    glav.Fields("cn_osn_razm_procata").Value + " " + edinizm)) / 15) + 1
                   
                        
                   If kol_st > (29 - ns) Or post_st > (29 - ns) Then
                         i = 0
                    For i = 0 To (29 - ns)
                         nrow
                    Next i
                    End If
                        
                        
                        q = r
                        w = r
                        nss = ns
                       
                        Rem BAV èñïîëüçîâàë èìåþùóþñÿ ïðîöåäóðó è óáðàë ëèøíèé êîä è ïåðåìåííóþ
                    '    Select Case kod
                    '        Case 1: edinizm = "ìì"
                    '        Case 3: edinizm = "ì"
                    '        Case 6: edinizm = "ã"
                    '        Case 7: edinizm = "êã"
                    '        Case 8: edinizm = "ò"
                    '        Case 9: edinizm = "ë"
                    '        Case 11: edinizm = "ñì2"
                    '        Case 12: edinizm = "ñì"
                    '        Case 13: edinizm = "ìì2"
                    '        Case 14: edinizm = "ì2"
                    '        Case 15: edinizm = "øò"
                    '        Case 16: edinizm = "ì3"
                    '        Case 17: edinizm = "äì"
                    '        Case 18: edinizm = "êì"
                    '    End Select
                        Excel.Range("H" & Format(r)).Select
                        Dim slog As String
                        If glav.Fields("cn_kod_procata") <> " " Or glav.Fields("cn_kod_procata") <> Null Then
                            If InStr(glav.Fields("cn_obozn_stand").Value, "Ïðîâîä") > 0 Then
                             slog = glav.Fields("cn_obozn_stand").Value + " " + glav.Fields("cn_osn_razm_procata").Value + _
                                   " " + glav.Fields("cn_osn_razm").Value + " " + edinizm
                            Else
                            slog = glav.Fields("cn_obozn_stand").Value + " " + glav.Fields("cn_osn_razm").Value + _
                                   " " + glav.Fields("cn_osn_razm_procata").Value + " " + edinizm
                                   End If
                            Addnrow2 slog, "H", "", 0, 15
                        Else
                            slog = glav.Fields("cn_obozn_stand").Value + " " + glav.Fields("cn_osn_razm").Value + _
                                   " " + edinizm
                            Addnrow2 glav.Fields("cn_obozn_stand").Value + " " + glav.Fields("cn_osn_razm").Value + _
                                     " " + edinizm, "H", "", 0, 15
                        End If
                        If glav.Fields("CN_KATEGORIA_MAT_GOSTA").Value <> " " Then
                            Excel.Range("AV" & Format(w)).Select
                            Excel.ActiveCell.FormulaR1C1 = glav.Fields("CN_KATEGORIA_MAT_GOSTA").Value
                        End If
                    Else
                        nrow
                        q = r
                        w = r
                        nss = ns
                        Excel.Range("H" & Format(r)).Select
                        Addnrow2 glav.Fields("cn_obozn_stand").Value + " " + glav.Fields("cn_osn_razm").Value, "H", "", 0, 25
                        If glav.Fields("CN_KATEGORIA_MAT_GOSTA").Value <> " " Then
                            Excel.Range("AV" & Format(w)).Select
                            Excel.ActiveCell.FormulaR1C1 = glav.Fields("CN_KATEGORIA_MAT_GOSTA").Value
                        End If
                    End If
                End If
                t = r   '''
                
    If Check2.Value = 1 And IsNull(glav.Fields("CN_KOD_PROCATA")) = False Then  ' Sei ïî çàÿâêå Ñèçîâîâîé  23,09,10 âûâîäèòü âåñ 1 ìåòðà
                Dim massa
                Set mas = New ADODB.Recordset
                 mas.ActiveConnection = dc
                 With mas
                  massql = "select t.cn_ves_pogon_m from tn_prokat t where t.cn_kod_prokata = '" + CStr(glav.Fields("CN_KOD_PROCATA")) + "'"
                 
                  .CursorLocation = adUseServer
                  .CursorType = adOpenStatic
                  .LockType = adLockOptimistic
    End With
    mas.Open massql
   
    If mas.RecordCount > 0 Then
       massa = mas.Fields("cn_ves_pogon_m").Value
    End If
    mas.Close
    End If
    ' SEI 09.11.2010 ïî çàÿâêå Êè÷èãèíîé.. åñëè åñòü çíàê $ òî â ãðàôó "Ïðèìå÷àíèå" âûâîäèì çíà÷åíèå ñ âêëàäêè Comp. <ïðèìå÷àíèå>
    If InStr(glav.Fields("CN_PRIMECH").Value, "$") > 0 Then
       Excel.Range("EF" & Format(w)).Select
       Excel.ActiveCell.FormulaR1C1 = Replace(glav.Fields("CN_PRIMECH").Value, "$", "")
       Else
           Rem åñëè â ïîëå ñîäåðæèòñÿ çíà÷åíèå íå 7 (êã), òî âûâåñòè åäèíèöó èçìåðåíèÿ ïîñëå çíà÷åíèÿ ìàññû.
           Rem åäèíèöà èçìåðåíèÿ íàõîäèòñÿ â ôóíêöèè edin. Åñëè ñåìü, òî åäèíèöà èçìåðåíèÿ íå âûâîäèòñÿ
           If glav.Fields("CN_ED_IZM_MASSY_STAND").Value <> 7 Then
              Excel.Range("EF" & Format(w)).Select
              Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_massa_stand").Value + _
              edin(glav.Fields("CN_ED_IZM_MASSY_STAND").Value)
              Else
                  Excel.Range("EF" & Format(w)).Select
                  If Check2.Value = 1 And IsNull(glav.Fields("CN_KOD_PROCATA")) = False Then
                     Excel.ActiveCell.FormulaR1C1 = massa
                     Else
                         ' ïðè òèïå äåòàëè "ìîäåëü äîðàáîòàííîãî ïîêóïíîãî äëÿ ÂÏ" âûâîäèòü ìàññó ñ ïàñïîðòà äåòàëè
                         If glav.Fields("cn_tip_md") = 23 Then
                            Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_mass")
                            Else
                                Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_massa_stand").Value
                         End If
                  End If
                    
                  ' êîëè÷åñòâî â óïàêîâêå
                  If glav.Fields("cn_zav_nomer") <> "" Then
                     Excel.Range("EF" & Format(w + 1)).Select
                     Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_zav_nomer")
                  End If
           End If
    End If
            End If
            Dim ROD As ADODB.Recordset

Rem ///////////////////////////////////////////////////////////////////////////////
Rem æåëàòåëüíî èçáàâèòüñÿ îò extentional.child
            Rem â Recordset ROD ïîìåùàþòñÿ âñå àòðèáóòû èõ çíà÷åíèÿ âûâîäèìîãî â îò÷åòå îáúåêòà
            
            
            If glav.Fields("OBJECT_STAND") <> " " Then
                Set ROD = New ADODB.Recordset
                ROD.ActiveConnection = dc
                With ROD
                    rodsql = "select distinct * from extentional.child s " + _
                             "where s.child='" + CStr(glav.Fields("OBJECT_STAND").Value) + "'" + _
                             "and s.user_ob='" + CStr(us) + "'" + _
                             " order by s.obozn"
                    .CursorLocation = adUseServer
                    .CursorType = adOpenStatic
                    .LockType = adLockOptimistic
                End With
                ROD.Open rodsql
            Else
                Set ROD = New ADODB.Recordset
                ROD.ActiveConnection = dc
                With ROD
                    rodsql = "select distinct * from extentional.child s " + _
                             "where s.child='" + CStr(glav.Fields("OBJECT_ID").Value) + "'" + _
                             "and s.user_ob='" + CStr(us) + "'" + _
                             " order by s.obozn"
                    .CursorLocation = adUseServer
                    .CursorType = adOpenStatic
                    .LockType = adLockOptimistic
                End With
                ROD.Open rodsql
            End If
            r = ob
            If ROD.RecordCount > 0 Then
    '            Dim a As Integer
Rem /////////////////////////////////

               For A = 0 To ROD.RecordCount - 1
                    ' SAU 23.01.09 Äîïèñàëà óìíîæåíèå êîë-âà ïîêóïíîãî íà êîë-âî ðîäèòåëÿ â êîòîðîå îíî âõîäèò.
                    ' Äîïèñàëà ïðîöåäóðû FIND_POKUPNYE è CHILD_KD
                    'If ROD.Fields("kol_for_basy") <> "-32767" Then
                    '    ROD.Fields("kol") = ROD.Fields("kol_for_basy") '* rodit(3)
                    'Else
                    '    If ROD.Fields("kol_rod") <> 0 Then
                    '        ROD.Fields("kol") = ROD.Fields("kol") * ROD.Fields("kol_rod")
                    '    Else
                    '    End If
                    'End If                                                                    ' ×ÎÞ çàêîìåíòèðîâàëà, ò.ê. êîëè÷åñòâî äëÿ áàñó íå âûâîäèëîñü(îøèáêà)
                    
                    Rem ïîëó÷åíèå êîëè÷åñòâà íà èçäåëèå (kolich) è êîëè÷åñòâà â êîìïëåêòû (kolichkom)
                    Dim kolichkom As Variant
                    Dim kolich As Variant
                    Dim kolichreg As Variant
                    Dim obch_kol As Variant
                    
                    If ROD.Fields("tip") = 4 And ROD.Fields("ob_rod") <> ispoln2 Then
                        If ROD.Fields("kol") <> " " Then
                           If ROD.Fields("kol_for_basy") <> "-32767" Then
                                kolichkom = ROD.Fields("kol_for_basy").Value + kolichkom
                            Else
                                kolichkom = ROD.Fields("kol").Value + kolichkom
                            End If
                        End If
                    End If
                    Rem BAV óáðàë âñå ïðîâåðêè íà ñåðâåð
                    If ROD.Fields("tip") <> 4 Or (ROD.Fields("tip") = 4 And ROD.Fields("ob_rod") = ispoln2) Then
                    If ROD.Fields("kol") <> " " Then
                     If ROD.Fields("kol_for_basy") <> "-32767" Then
                        kolich = ROD.Fields("kol_for_basy").Value + kolich    ' sei 28.10.10, ïî ä\ç îò Êè÷èãèíîé, áûëî glav.Fields("cn_quantity") + kolich
                        Else
                        kolich = glav.Fields("cn_quantity") + kolich
                       End If
                      End If
                    End If
                    
                    
                    Rem BAV ïîëó÷åíèå êîëè÷åñòâà íà ðåãóëèðîâàíèå (kolichreg)
                    If glav.Fields("cn_volume") = 0 Then
                        kolichreg = 0
                    Else
                        kolichreg = glav.Fields("cn_volume")
                    End If
                    
                                        
                    Dim trym As String 'Åä.èçì.
                    If ROD.Fields("ed_izm") = 3 Then
                        w = w + 1
                        trym = ""
                        trym = edin(ROD.Fields("ed_izm").Value)
                    End If
                    Rem âûâîä îáîçíà÷åíèÿ â ãðàôó "Êóäà âõîäèò" îò÷åòà
                    If ROD.RecordCount = 1 Then
                        Excel.Range("CI" & Format(w)).Select
                        Excel.ActiveCell.FormulaR1C1 = ROD.Fields("obozn").Value
                        If frmMain.Check1 = 1 Then
                            If Trim(ROD.Fields("yzel")) <> "*" Or ROD.Fields("yzel") <> "* " Then
                                Excel.Range("EM" & Format(w)).Select
                                Excel.ActiveCell.FormulaR1C1 = ROD.Fields("yzel").Value
                            End If
                        End If
Rem ////////////////////////////////////////////////////////////////
                        
                        Rem âûâîä â ãðàôó "êîëè÷åñòâî íà èçäåëèå"
                        
                        If kolich = 0 Then
                            Excel.Range("DG" & Format(q)).Select
                            Excel.ActiveCell.FormulaR1C1 = " "
                        Else
                            Excel.Range("DG" & Format(q)).Select
                            If glav.Fields("cn_tip_md") = 21 _
                                And glav.Fields("cn_cn_md_ed_izm_gab") = 1 _
                                Or glav.Fields("ed_izm_proc") = 13 Then
                                Excel.ActiveCell.FormulaR1C1 = kolich
                                Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym + " ì"
                            Else
                                Excel.ActiveCell.FormulaR1C1 = kolich
                                Rem  ôîðìàòèðîâàíèÿ ÷èñëà â ÿ÷åéêå Excel êàê òåêñò
                                Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                            End If
                        End If
                        If kolichreg = 0 Then
                            Excel.Range("DS" & Format(q)).Select
                            Excel.ActiveCell.FormulaR1C1 = " "
                        Else
                            Excel.Range("DS" & Format(q)).Select
                            If glav.Fields("cn_tip_md") = 21 _
                                And glav.Fields("cn_cn_md_ed_izm_gab") = 1 _
                                Or glav.Fields("ed_izm_proc") = 13 Then
                                Excel.ActiveCell.FormulaR1C1 = kolichreg
                                Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym + " ì"
                            Else
                                Excel.ActiveCell.FormulaR1C1 = kolichreg
                                Rem  ôîðìàòèðîâàíèÿ ÷èñëà â ÿ÷åéêå Excel êàê òåêñò
                                Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                            End If
                        End If
                        If kolich = 0 And kolichkom = 0 And kolichreg = 0 Then
                            Excel.Range("DZ" & Format(q)).Select
                            Excel.ActiveCell.FormulaR1C1 = " "
                        Else
                            Rem âûâîä â ãðàôó "êîëè÷åñòâî â êîìïëåêòû"
                            If kolichkom <> 0 Then
                                Excel.Range("DM" & Format(q)).Select
                                Excel.ActiveCell.FormulaR1C1 = kolichkom
                                Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                            End If
                            
                            Rem âûâîä â ãðàôó "êîëè÷åñòâî âñåãî"
                            Excel.Range("DZ" & Format(q)).Select
                            If glav.Fields("cn_tip_md") = 21 _
                                And glav.Fields("cn_cn_md_ed_izm_gab") = 1 _
                                Or glav.Fields("ed_izm_proc") = 13 Then
                                Excel.ActiveCell.FormulaR1C1 = kolich + kolichkom + kolichreg
                                Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + " ì"
                            Else
                                If glav.Fields("cn_tip_md") = 21 _
                                    And glav.Fields("cn_cn_md_ed_izm_gab") = 3 Then
                                    Excel.ActiveCell.FormulaR1C1 = kolich + kolichkom + kolichreg
                                    Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym + " ì"
                                Else
                                    Excel.ActiveCell.FormulaR1C1 = kolich + kolichkom + kolichreg
                                    Rem  ôîðìàòèðîâàíèÿ ÷èñëà â ÿ÷åéêå Excel êàê òåêñò
                                    Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                                End If
                            End If
                        End If
                        kolich = 0
                        kolichkom = 0
                        '29.04.08 SAU Âûâîä ïîñòàâùèêîâ
                        Rem ââîä çíà÷åíèÿ â ïîëå ïîñòàâùèê ñ ïîìîùüþ ïðîöåäóðû ðàçáèâêè äëèííûõ ñòðîê
                        Addnrow3 glav.Fields("cn_teh_marshrut").Value, "BQ", "", q, 0, 20
        Else                          ' áëîê îò Rod = 1
                     
                    Dim w1 As Integer
                    
                            Excel.Range("CI" & Format(w)).Select
                            Excel.ActiveCell.FormulaR1C1 = ROD.Fields("obozn").Value
                            If frmMain.Check1 = 1 Then
                            If ROD.Fields("yzel") <> "* " Or ROD.Fields("yzel") <> "*" Then
                                    Excel.Range("EM" & Format(w)).Select
                                   Excel.ActiveCell.FormulaR1C1 = ROD.Fields("yzel").Value
                              End If
                           End If
                           If kolich = 0 And kolichkom = 0 Then
                              Excel.Range("DZ" & Format(w)).Select
                                Excel.ActiveCell.FormulaR1C1 = " "
                            Else
                                If kolichkom <> 0 Then
                                    Excel.Range("DM" & Format(w)).Select
                                  Excel.ActiveCell.FormulaR1C1 = kolichkom
                                  Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                                                               
                              End If
                                 If kolich <> 0 Then
                                    Excel.Range("DG" & Format(w)).Select
                                    Excel.ActiveCell.FormulaR1C1 = kolich
                                    Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                                                               
                                End If
                               
                                 Excel.Range("DZ" & Format(w)).Select
                                 obch_kol = kolichkom + kolich + kolichreg + obch_kol
                                 Excel.ActiveCell.FormulaR1C1 = kolichkom + kolich + kolichreg
                                 Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                                 w = w + 1
                                 w1 = w
                                If A = ROD.RecordCount - 1 Then
                                 w1 = w - 1
                                   Excel.Selection.Font.Underline = 4
                                   Excel.Range("DZ" & Format(w)).Select ' sei
                                   Excel.ActiveCell.FormulaR1C1 = obch_kol
                                   Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                                End If
                            End If
                            
                           
                          
                            'Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                            kolich = 0
                            kolichkom = 0
                            '29.04.08 SAU Âûâîä ïîñòàâùèêîâ
                            
                            Rem äîáàâèòü ïðîâåðêó åñëè ó ýëåìåíòà äâà ðîäèòåëÿ òî ïðîâåðÿòü ïóòè è íå ïîâòîðÿòü ïðîèçâîäèòåëÿ
                            If postavzhik <> glav.Fields("cn_teh_marshrut").Value Then
                                Addnrow3 glav.Fields("cn_teh_marshrut").Value, "BQ", "", q, 0, 20
                            End If
                            
                            
                              If (w1 = (29 + nl + 3)) And (nlist > 1) Then
                                 nrow
                                 w = r
                                 End If
                             postavzhik = glav.Fields("cn_teh_marshrut").Value
                       ' Else
                         '  If A <> 0 Then
                          '      w = w + 1
                          '  End If
                          '  Excel.Range("CI" & Format(w)).Select
                          '  Excel.ActiveCell.FormulaR1C1 = ROD.Fields("obozn").Value + ";"

                         '   If frmMain.Check1 = 1 Then
                          '      MsgBox Mid(ROD.Fields("yzel").Value, 1, InStr(1, ROD.Fields("yzel").Value, "*") + 1)
                           '     If Trim(ROD.Fields("yzel")) <> "*" Or ROD.Fields("yzel") <> "* " Then
                            '        Excel.Range("EM" & Format(w)).Select
                             '       Excel.ActiveCell.FormulaR1C1 = ROD.Fields("yzel").Value
                             '   End If
                           ' End If

                         '   If kolich = 0 And kolichkom = 0 Then
                          '      Excel.Range("DZ" & Format(q)).Select
                          '     Excel.ActiveCell.FormulaR1C1 = " "
                         '   Else
                           '     If kolichkom <> 0 Then
                            '        Excel.Range("DM" & Format(q)).Select
                             '       Excel.ActiveCell.FormulaR1C1 = kolichkom
                              '     Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                             '   End If
                             '
                             '   If kolich <> 0 Then
                              '      Excel.Range("DG" & Format(q)).Select
                               '     Excel.ActiveCell.FormulaR1C1 = kolich
                               '    Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                             '   End If
                                
                            '    If A = ROD.RecordCount Then
                            '        Excel.Range("DZ" & Format(q)).Select
                             '       Excel.ActiveCell.FormulaR1C1 = kolich + kolichkom
                              '      Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                             '   End If
                             '      Excel.Range("DZ" & Format(q)).Select                           'SEI 26.10.10 (ïî çàÿâêå Êè÷èãèíîé) ïî ãîñòó 2.106-96
                               '    Excel.ActiveCell.FormulaR1C1 = kolichkom + kolich
                                '   Excel.ActiveCell.FormulaR1C1 = Excel.ActiveCell.FormulaR1C1 + trym
                          '  End If
                           ' kolich = 0             '
                          '  kolichkom = 0          '

                            '29.04.08 SAU Âûâîä ïîñòàâùèêîâ
                            Rem ïðîöåäóðà ðàçáèâêè äëèííûõ ñòðîê (ñòðîêà, íà÷àëî äèàïàçîíà, êîíåö äèàïàçîíà, íîìåð ñòðîêè, ïðèçíàê æèðíîãî øðèôòà, äîïóñòèìàÿ äëèíà ñòðîêè)
                           
                           ' Addnrow3 glav.Fields("cn_teh_marshrut").Value, "BQ", "", q, 0, 20

                       End If
                     
                   ' End If
                   
                    Dim s As Integer
                    s = w
                    If t <= s Then
                       nrow
                     
                      ' If nlist = 1 Then
                      ' ns = s - nl - 4
                       'Else
                      ' ns = s - nl - 3
                      ' End If
                    End If
                    
                    Dim z As Integer
        
        
                    
Rem ////////////////////////////////////////////////////////////////////////////
Rem ìåòêà kon íå èñïîëüçóåòñÿ
kon:
                    ROD.MoveNext
                Next A
            End If

            kolich = 0
            kolichkom = 0
            obch_kol = 0
             
    If nlist = 1 And ROD.RecordCount > 1 Then
        If (w - 4) > ns Then                 'SEi 27.10.10
        ns = w - 4
        End If
    Else
        If (w - nl - 3) > ns And ROD.RecordCount > 1 Then
        ns = w - nl - 3
        End If
    End If
    
   If ROD.RecordCount = 1 And ns <> 28 Then
     nrow
     
   End If
  
Rem ////////////////////////////////////////////////////////////////////////////
Rem ìåòêà conec íå èñïîëüçóåòñÿ
conec:
            glav.MoveNext

        Wend

        If frmMain.Text1.Text <> "" And frmMain.Text1.Text <> 1 Then
            For i = 1 To CDbl(frmMain.Text1.Text) - 1
                nrow
            Next i
        End If

Rem /////////////////////////////////////////////////////////////
Rem ñîáñòâåííî ãîâîðÿ, à çà÷åì ñåáÿ áûëî óòðóæäàòü íàïèñàíèåì êîäà äî ìåòêè rrrr BAV çàêîììåíòèðîâàë _
    íåèñïîëüçóåìûé ïðîãðàììíûé êîä
 '       GoTo rrrr
'
'       Dim SE As New adodb.Recordset
 '       Set SE = New adodb.Recordset
  '      SE.ActiveConnection = dc
   '     With SE
'
 '           Sesql = "select * from konstr__tree t, tn_konstr_doc tn " + _
  '                  " Where t.object_id2 = tn.object_id " + _
   '                 " and t.OBJECT_ID1= " + CStr(PRMObject.ObjectId) + _
    '                " and t.CLASS_ID2=1576 and t.cn_not_use_vp_kd=-1  and tn.revision_stg=1"
     '       .CursorLocation = adUseServer
      '      .CursorType = adOpenStatic
       '     .LockType = adLockOptimistic
'        End With
 '       SE.Open Sesql
'
 '       For t = 0 To SE.RecordCount - 1
  '          If SE.RecordCount > 0 Then
   '             nrow
    '            Excel.Range("H" & Format(r) & ":EF" & Format(r)).Select 'h-p
     '           Excel.Selection.Merge
      '          Excel.ActiveCell.FormulaR1C1 = SE.Fields("CN_DOC_K_NAIMENOVANIE") + " " + _
       '         SE.Fields("CN_DOC_K_OBOZN") + " ÂÏ"
 ''
   '     ' Äîïèñàòü âûâîä ïðèìå÷àíèÿ 05.06.09
 '
  '          End If
   '         SE.MoveNext
    '    Next t
'
'rrrr:

    End If
 Else
     ' ñâîäíàÿ âåäîìîñòü
     If glav.RecordCount > 0 Then
        nrow
        Excel.Worksheets(1).Activate
        Excel.Range("H" & Format(r) & ":CI" & Format(r)).Select
        Excel.Selection.Merge
        Excel.Selection.HorizontalAlignment = xlLeft
        Excel.ActiveCell.FormulaR1C1 = "ÂÏ âõîäÿùèõ ñîñòàâíûõ ÷àñòåé:"
        
        While Not glav.EOF
        nrow
        nrow
        Excel.Range("H" & Format(r) & ":CI" & Format(r)).Select
        Excel.Selection.Merge
        Excel.Selection.HorizontalAlignment = xlLeft
        Excel.ActiveCell.FormulaR1C1 = glav.Fields("cn_doc_k_naimenovanie") + " " + glav.Fields("cn_doc_k_obozn") + " " + "ÂÏ"
        glav.MoveNext
        Wend

     End If
 
End If
    
    printPOK = 1
End Function

Private Sub Command2_Click()
    Rem îòîáðàæåíèå îêíà âèçóàëèçàöèè âåäîìîñòè â êîòîðîì ïðîèñõîäèò ëèáî âûçîâ ïðîöåäóðû Ved_Pok() _
        ëèáî çàêðûòèå ïðîãðàììû
    frmProgrBar.Show 1
    Rem ïåðåäà÷à óïðàâëåíèÿ ñîáûòèÿì Windows
    DoEvents
End Sub

Private Sub Form_load()

    Rem âîçâðàùàåò ññûëêó íà àêòèâíîå ïðèëîæåíèå èç ôàéëà
    Set SmApp = GetObject(, "SmarTeam.SmApplication")

    Rem âîçâðàùàåò êîëëåêöèþ îòêðûòîé ñåññèè
    Set SmSession = SmApp.Engine.Sessions(0)

    Rem âîçâðàùàåò ôóíêöèîíàë ìîäåëè äàííûõ ST
    Set MetaInfo = SmSession.MetaInfo
    Set Metaobj = MetaInfo

    Rem âîçâðàùàåò îïðåäåëåííûå íàäñòðîéêè ST êîòîðûå äîáàâëÿþòñÿ â ñëóæáû â ñîîòâåòñòâèè ñ ProjId
    Set GUISrv = SmSession.GetService("SmGUISrv.SmGUIServices")
    Rem ñîçäàåòñÿ ïîñòîÿííî ñóùåñòâóþùèé îáúåêò SmarTeam îïðåäåëåííûé ClassId è ObjecId _
        â äàííîì ñëó÷àå â òàáëèöó PRMObject çàïèñûâàåòñÿ âñÿ èíôîðìàöèÿ âûäåëåííîãî â SmarTeam îáúåêòà
    Set prmobject = SmSession.ObjectStore.RetrieveObject( _
        GUISrv.ActiveViewWindow.SmView.Selected.SingleObject.ClassId, _
        GUISrv.ActiveViewWindow.SmView.Selected.SingleObject.ObjectId)
    Rem ïîëó÷åíèå âñåõ àòòðèáóòîâ îáúåêòà (îíè óæå áûëè ïîëó÷åíû!!!)
  '  PRMObject.AddAllAttributes
    Rem ïîëó÷åíèå âñåõ äàííûõ îáúåêòà (îíè óæå áûëè ïîëó÷åíû!!!)
  '  PRMObject.Retrieve
      
    Rem ïðîâåðêà íà ïîñëåäíþþ âåðñèþ
   ' If PRMObject.Data.Value("REVISION_STG") = 0 Then
   '     MsgBox "Íå ïîñëåäíÿÿ âåðñèÿ!", vbCritical
    '    Unload Me
    '    Exit Sub
  '  End If

    Rem âûâîä îáîçíà÷åíèÿ, íàçâàíèÿ è âåðñèè âûäåëåííîãî îáúåêòà â ãëàâíîé ôîðìå âåäîìîñòè
    Label3.Caption = prmobject.Data.Value("CN_DOC_K_OBOZN") + " " + prmobject.Data.Value("CN_DOC_K_NAIMENOVANIE") + " " + _
                     "âåðñèÿ:" + " " + prmobject.Data.Value("REVISION")

    Set dc = New ADODB.Connection
    Dim hLib As Long
    Dim strFileName As String
    Dim hProc As Long
    Dim hProc1 As Long
    Dim ss As Long
    Dim st As Long
    Dim workdir1 As String
        
    Rem ïîëó÷åíèå ïóòè ê áèáëèîòåêè DLL
    workdir1 = SmSession.Config.HomeDirectory
    workdir1 = workdir1 + "\bin\configs.dll"
    strFileName = workdir1
    Rem ïåðåìåííàÿ hLib áóäåò ñîäåðæàòü äåñêðèïòîð áèáëèîòåêè DLL â ñëó÷àå óäà÷íîé çàãðóçêè _
        ýòîò äåñêðèïòîð ìîæíî áóäåò èñïîëüçîâàòü äëÿ ïîëó÷åíèÿ äåñêðèïòîðîâ äëÿ âûçîâà ôóíêöèé _
        áèáëèîòåêè DLL ñ ïîìîùüþ GetProcAddress
    hLib = LoadLibrary(strFileName)
    Rem ïðîâåðêà áûëà ëè ïîëó÷åíà áèáëèîòåêà
    If hLib = 0 Then
        MsgBox "Dll not found"
        Exit Sub
    End If
    Rem ïîëó÷åíèå äåñêðèïòîðà íà õðàíèìóþ ôóíêöèþ
    hProc = GetProcAddress(hLib, "Getdb1")
    Rem âûçîâ õðàíèìîé â DLL ôóíêöèè
    ss = CallWindowProc(hProc, 0, ByVal 0&, ByVal 0&, ByVal 0&)
    If ss <> 0 Then
        Dim d As String
        Rem ïîëó÷åíèå ñòðîêè ïîäêëþ÷åíèÿ ê ÁÄ
        d = StringFromPointer(ss, 255)
        dc.ConnectionString = d
    Else
        MsgBox "Function not found in DLL"
    End If
    
    'Ïîäêëþ÷åíèå ê template (øàáëîíû)
    hProc = GetProcAddress(hLib, "GetTemplate")
    st = CallWindowProc(hProc, 0, ByVal 0&, ByVal 0&, ByVal 0&)
    If st <> 0 Then
        Dim d1 As String
        Rem ïîëó÷åíèå ñòðîêè ïîäêëþ÷åíèÿ ê Smartas
        d1 = StringFromPointer(st, 255)
        sRet = d1
    Else
        MsgBox "Function not found in DLL"
    End If

    Call FreeLibrary(hLib)
    Rem îòêðûâàåòñÿ ñîåäèíåíèå ñ ÁÄ
    dc.Open
    Rem ïîëó÷åíèå UserId ïîëüçîâàòåëÿ
    us = SmSession.UserMetaInfo.UserId
    Dim users As ADODB.Recordset
    Set users = New ADODB.Recordset
    users.ActiveConnection = dc
    Rem çàïðîñ íà âûáîðêó ïîëüçîâàòåëåé (ïî àëôàâèòó - order) ÎÃÊ ñ óäàëåíèåì ïîâòîðÿþùèõñÿ çàïèñåé (distinct)
    Sql = "select distinct u.login from USERS u where u.login!=' '" + _
          " and u.USER_DIVISION like 'ÎÃÊ%'  order by u.login"
    With users
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    Rem çàïîëíåíèå îáúåêòà recordset (òàáëèöû) ïîëüçîâàòåëÿìè ÎÃÊ
    users.Open Sql
    Rem ââîä ïîëüçîâàòåëåé ÎÃÊ â êîìáîáîêñû (Ðàçðàá., Ïðîâ., Íà÷.áþðî, Í.êîíòð., Óòâ.)
    While Not users.EOF
        Combo1.AddItem users.Fields("LOGIN").Value
        Combo2.AddItem users.Fields("LOGIN").Value
        Combo3.AddItem users.Fields("LOGIN").Value
        Combo4.AddItem users.Fields("LOGIN").Value
        Combo5.AddItem users.Fields("LOGIN").Value
        users.MoveNext
    Wend
    Rem ââîä â ïîëå ðàçðàáîòàë àêòèâíîãî ïîëüçîâàòåëÿ çàïóñòèâøåãî âåäîìîñòü
    Combo1.Text = SmSession.UserMetaInfo.user.Value("LOGIN")
    Rem ñîçäàåòñÿ ïîñòîÿííî ñóùåñòâóþùèé îáúåêò SmarTeam îïðåäåëåííûé ClassId è ObjecId _
        â äàííîì ñëó÷àå â user âíîñèòñÿ âñÿ èíôîðìàöèÿ î òåêóùåì ïîëüçîâàòåëå èç òàáëèöû Users
    Set user = SmSession.ObjectStore.RetrieveObject(3, us)
    MAIN_SECURE_USER_ROLE = user.Data.Value("CN_MAIN_SECURE_USER_ROLE")
    obozn = prmobject.Data.Value("CN_DOC_K_OBOZN")
    Rem çàãðóæàåì âñå èñïîëíåíèÿ îáúåêòîâ
    
        '22.10.2008 SAU
Rem ///////////////////////////////////////////////////////////////////////////////////////////////
Rem BAV óáðàë â ïðîöåäóðó íà ñåðâåðå óäàëåíèå èíôîðìàöèè î ïðîåêòå äëÿ èñêëþ÷åíèÿ äóáëèðîâàíèÿ
    Dim DelExt As ADODB.Command
    Set DelExt = New ADODB.Command
    DelExt.ActiveConnection = dc
    DelExt.CommandText = "PROC_DEL_EXT_KD" 'ÈÌß ÏÐÎÖÅÄÓÐÛ
    Rem îòêðûòèå óêàçàííîé ïðîöåäóðû íà ñåðâåðå
    DelExt.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
    Rem ïåðåäà÷à íåîáõîäèìûõ ïàðàìåòðîâ õðàíèìîé ïðîöåäóðå íà ñåðâåðå
    DelExt.Parameters.Append DelExt.CreateParameter("in_user", adInteger, adParamInput, 10, us)
    Rem çàïóñê õðàíèìîé ïðîöåäóðû íà ñåðâåðå
    DelExt.Execute
    
Rem BAV ïåðåíåñ èç ãëàâíîãî ìîäóëÿ äëÿ èñêëþ÷åíèÿ îøèáêè ïðè ïåðâîì çàïóñêå
    Rem âûïîëíåíèå õðàíèìîé íà ñåðâåðå ïðîöåäóðû. Íàõîäèò âñå èñïîëíåíèÿ âûäåëåííîãî îáúåêòà.
    Dim cmd0 As ADODB.Command
    Set cmd0 = New ADODB.Command
    cmd0.ActiveConnection = dc
    cmd0.CommandText = "FIND_ISPOLN_KD" 'ÈÌß ÏÐÎÖÅÄÓÐÛ
    Rem îòêðûòèå óêàçàííîé ïðîöåäóðû íà ñåðâåðå
    cmd0.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
    Rem ïåðåäà÷à íåîáõîäèìûõ ïàðàìåòðîâ õðàíèìîé ïðîöåäóðå íà ñåðâåðå
    cmd0.Parameters.Append cmd0.CreateParameter("in_obozn", adChar, adParamInput, 255, prmobject.Data.Value("CN_DOC_K_OBOZN"))
    cmd0.Parameters.Append cmd0.CreateParameter("in_object_id", adInteger, adParamInput, 10, prmobject.ObjectId)
    cmd0.Parameters.Append cmd0.CreateParameter("in_user", adInteger, adParamInput, 10, us)
    cmd0.Parameters.Append cmd0.CreateParameter("in_visota", adChar, adParamInput, 10, prmobject.Data.Value("CN_CCE_VISOTA"))
    cmd0.Parameters.Append cmd0.CreateParameter("in_dlina", adChar, adParamInput, 10, prmobject.Data.Value("CN_CCE_DLINA"))
    cmd0.Parameters.Append cmd0.CreateParameter("in_cn_mass", adDouble, adParamInput, 10, prmobject.Data.Value("CN_MASS"))
    cmd0.Parameters.Append cmd0.CreateParameter("in_ed_izm_massi", adInteger, adParamInput, 10, prmobject.Data.Value("CN_ED_IZM_MASSI "))
    Rem çàïóñê õðàíèìîé ïðîöåäóðû íà ñåðâåðå
    cmd0.Execute
    
    
    Set ispoln = New ADODB.Recordset
    ispoln.ActiveConnection = dc
    Rem çàïðîñ íà îáúåêòû âûãëÿäÿùèå êàê "îáîçíà÷åíèå" è "îáîçíà÷åíèå-èñïîëíåíèå" _
        êëàññà 1576 (TN_CATIA_PRODUCT) òåêóùåãî ïîëüçîâàòåëÿ óïîðÿäî÷åííûõ ïî îáîçíà÷åíèþ
    sqlisp = "select * from extentional.glavnaia g" + _
             " where g.class_id = 1576 and g.users_object =  " + CStr(us) + _
             " and (g.cn_doc_k_obozn like '" + obozn + "'||'-%' or g.cn_doc_k_obozn='" + obozn + "') order by g.cn_doc_k_obozn"
    With ispoln
        .CursorLocation = adUseServer
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
    End With
    ispoln.Open sqlisp
    If ispoln.RecordCount = 0 Then
        ispoln.Close
        ispoln.Open sqlisp
    End If
    Rem åñëè èñïîëíåíèå îäíî îò äåàêòèâèðîâàòü îïöèþ "ãðóïïîâàÿ âåäîìîñòü" _
        åñëè íåñêîëüêî - òî àêòèâèðîâàòü
    If ispoln.RecordCount = 1 Then
        Option2.Enabled = False
    Else
        Option2.Value = True
    End If
    Rem çàïèñàòü êîëè÷åñòâî èñïîëíåíèé
    kolcount = ispoln.RecordCount
    Rem îòîáðàæàåòñÿ ãëàâíîå îêíî âåäîìîñòè ïåðåõîä ê Sub Command2_Click _
        èëè ïðè îòìåíå ê Sub Command1_Click
End Sub
'**********************************************************************************
'    Ôóíêöèÿ âîçâðàùàåò ïóòü ê ôîðìå äîêóìåíòà ïî îáîçíà÷åíèþ ôîðìû
'**********************************************************************************
Function GetFormFileName(SmSession As SmApplic.SmSession, Form_Name As String, f_name As String) As String
    Dim ret As Integer
    Dim FDclid As Integer
    Dim MetaInfo As SmApplic.SmMetaInfo
    Dim Query As SmApplic.ISmQuery
    Dim QD As SmApplic.ISmQueryDefinition
    Dim FILE_NAME As String
    Dim DIRECTORY_NAME As String
    Dim tstr As String
    Dim fobjid As Long
    Dim fdrl As SmApplic.ISmObject
    Dim abc As String
    Dim FormPath As String
    'Èíèöèàëèçàöèÿ
    Set MetaInfo = SmSession.MetaInfo
    Set Query = SmSession.ObjectStore.NewQuery
    Set QD = Query.QueryDefinition
    FDclid = MetaInfo.SmClassByName("Ôîðìû äîêóìåíòîâ").ClassId
    QD.Clear
    'Çàïîëíåíèå çàïðîñà
    QD.Roles.add FDclid, "F"
    QD.Where.add "", "CN_FORM_DOC_OBOZN", "=", Form_Name, True, "F"
    QD.Select.add "DIRECTORY", "F", False
    QD.Select.add "FILE_NAME", "F", False
    QD.Select.add "OBJECT_ID", "F", False
    QD.Select.add "CLASS_ID", "F", False
    Query.Run
    If Query.QueryResult.RecordCount > 0 Then
        Dim fpath As String
        DIRECTORY_NAME = Query.QueryResult.Value("DIRECTORY", 0)
        FILE_NAME = Query.QueryResult.Value("FILE_NAME", 0)
        fpath = DIRECTORY_NAME + "\" + FILE_NAME
        GetFormFileName = fpath
   End If
End Function
'================================================================================================
' ôóíêöèÿ äîáàâëÿåò íîâóþ ñòðîêó â îò÷¸ò
'================================================================================================
Sub nrow()
   ' If ns <> 16 And ns <> 24 Then
      '  ns = ns + 1
   ' Else
      '  ns = ns + 2
   ' End If
   ns = ns + 1
    Rem êîïèðîâàíèå ëèñòà ïðè äîñòèæåíèè óêàçàííûõ çíà÷åíèé, ãäå ns - ñòðîêà, nlist - ñòðàíèöà
    If (ns >= 25 And nlist = 1) Or (ns >= 29 And nlist > 1) Then
        
        Excel.Workbooks(2).Activate
        Rem êîïèðîâàíèå ëèñòà øàáëîíà
        Excel.Range("A1:EL36").Select
        Excel.Selection.Copy
        
        If nlist = 1 Then
            nl = nl + 38
        Else
            nl = nl + 36
        End If
        ns = CDbl(frmMain.Text1.Text)
Rem ////////////////////////////////////////////////////////////////////
Rem çà÷åì ïåðåìåííàÿ j??? îáúÿâëÿåòñÿ â addnrow2,3 ïðèñâàèâàåòñÿ çíà÷åíèÿ 0 è 1 â nrow (íåìöû íå äîãàäàþòñÿ!!!)
        j = 0
        sh = 4 'äëÿ âòîðîãî è ïîñëåäóþùèõ ëèñòîâ
        nlist = nlist + 1
        Excel.Workbooks(1).Activate
        Excel.Range("A" & Format(nl)).Select
        Rem âñòàâêà ñêîïèðîâàííîãî ëèñòà
        Excel.ActiveSheet.Paste
        Rem óñòàíîâêà âûñîòû ñòðîê ëèñòà è îñíîâíîé íàäïèñè
         Excel.Range("ER" & (nl) & ":ER" & (nl + 1)).Select
        Excel.Selection.RowHeight = 10
        
        Excel.Range("ER" & (nl + 2) & ":ER" & (nl + 33)).Select
        Excel.Selection.RowHeight = 17.5
        
        Excel.Range("ER" & (nl + 33) & ":ER" & (nl + 33)).Select
        Excel.Selection.RowHeight = 10
        
        Excel.Range("ER" & (nl + 34) & ":ER" & (nl + 34)).Select
        Excel.Selection.RowHeight = 10
        
        Excel.Range("ER" & (nl + 35) & ":ER" & (nl + 35)).Select
        Excel.Selection.RowHeight = 10
        
        prim_z = ""
        prim_z2 = ""
    Else
        j = 1
    End If
    Excel.Workbooks(1).Activate
    r = nl + ns + sh
    w1 = r
End Sub
'**********************************************
'Ôóíêöèÿ ðàçáèâàåò äëèííûå ïåðåìåííûå íà ñòðîêè
'**********************************************
Sub Addnrow2(strf As Variant, flit As String, llit As String, st As Integer, mlen As Integer)
    Dim buf As String
    Dim strv As String
    Dim i As Integer
    Dim j As Integer
    Dim fpr As Integer
    i = 0
    fpr = 0
    Rem îáúåäèíåíèå äèàïàçîíà ñòðîêè
    If llit <> "" Then
        Excel.Range(flit & Format(r) & ":" & llit & Format(r)).Select
        Excel.Selection.Merge
    End If
    Rem Åñëè ñòðîêà ââîäà ìåíüøå äîïóñòèìîé ñòðîêè, òî ïðîñòî çàïèñàòü â óêàçàííóþ ÿ÷åéêó ñòðîêó ââîäà
    Rem è ïåéòè ê ìåòêå at
    
    If Len(Format$(strf)) <= mlen Then
        Excel.Range(flit & Format(r)).Select
        Excel.ActiveCell.FormulaR1C1 = Format$(strf)
        GoTo at
    End If
    For i = 0 To mlen - 1
        Rem Ïîèñê ïðîáåëà â ñòðîêå
        If Mid$(strf, mlen - i, 1) = " " Then
            Rem åñëè íàéäåí, òî îáðåçàòü ñòðîêó ïî ýòîìó ïðîáåëó... æåëàòåëüíî ñäåëàòü ïðîâåðêó íà ñèìâîëû (ïåðåíîñû)
            Excel.Range(flit & Format(r)).Select
            Excel.ActiveCell.FormulaR1C1 = Left$(Format$(strf), mlen - i)
            fpr = 1
            Exit For
        End If
        If (ns >= 24 And nlist = 1) Or (ns >= 29 And nlist > 1) Then
            nrow
            nrow
            '27.10.08 SAU äëÿ òèõîìèðîâà ñòðî÷êè ïðûãàþò
            w = r
            q = r
        End If
    Next i
    If fpr = 0 Then
        Excel.Range(flit & Format(r)).Select
        Excel.ActiveCell.FormulaR1C1 = Left$(Format$(strf), mlen)
        i = 0
    End If
at:
    If st = 1 Then
        Excel.Selection.Font.Bold = True
    End If
Rem-----------------------------BAV âûâîä èíäåêñà êâàäðàòà ïðè ââîäå êâ.ìì è êâ.ì-----------------------------------
    If InStr(1, Excel.ActiveCell.FormulaR1C1, "êâ.ìì") Then
        Excel.ActiveCell.FormulaR1C1 = Replace(Excel.ActiveCell.FormulaR1C1, "êâ.ìì", "ìì2")
        Excel.ActiveCell.Characters(InStr(Left$(Format$(strf), mlen - i), "êâ.ìì") + 2, 1).Font.Superscript = True
    ElseIf InStr(1, Excel.ActiveCell.FormulaR1C1, "êâ.ì") Then
        Excel.ActiveCell.FormulaR1C1 = Replace(Excel.ActiveCell.FormulaR1C1, "êâ.ì", "ì2")
        Excel.ActiveCell.Characters(InStr(Left$(Format$(strf), mlen - i), "êâ.ì") + 1, 1).Font.Superscript = True
    End If
Rem--------------------------BAV âûâîä çíà÷êà äèàìåòðà âìåñòî ôX, ãäå Õ-ðàçìåð äèàìåòðà-----------------------------
    Select Case Mid(Excel.ActiveCell.FormulaR1C1, InStr(Excel.ActiveCell.FormulaR1C1, " ô") + 2, 1)
        Case 1 To 9
             Excel.ActiveCell.FormulaR1C1 = Replace(Excel.ActiveCell.FormulaR1C1, "ô", Chr(133))
    End Select
    
Rem-----------------------------------------------------------------------------------------------------------------
    If Len(Format$(strf)) > mlen Then
        fper = 1
        Rem äîáàâëåíèå íîâîé ñòðîêè äëÿ çàïèñè îêîí÷àíèÿ ñòðîêè ââîäà
        
        nrow
        Rem Çàïèñü â ïåðåìåííóþ buf îêîí÷àíèÿ ñòðîêè ââîäà
        buf = Right$(Format$(strf), Len(Format$(strf)) - mlen + i)
        add = add + 1
        Rem ðåêóðñèâíûé âûçîâ ïðîöåäóðû äëÿ çàïèñè îêîí÷àíèÿ ñòðîêè ââîäà, ïðè ýòîì â ïðîöåäóðó
        Rem ïåðåäàåòñÿ íåçàïèñàííîå îêîí÷àíèå ñòðîêè ââîäà
        Addnrow2 buf, flit, llit, st, mlen
    End If
    Rem ïðîâåðÿåò âõîæäåíèå îäíîé ñòðîêè â äðóãóþ 1 - ñòàðòîâàÿ ïîçèöèÿ
    If InStr(1, strf, "ì2") > 0 _
      Or InStr(1, strf, "ì3") > 0 _
      Or InStr(1, strf, "ìì2") > 0 Then
        Excel.ActiveCell.Characters(Len(strf), Len(strf) - 1).Font.Superscript = True
    End If
 
 End Sub

'**********************************
'Ôóíêöèÿ ïåðåâîäà åäèíèöû èçìåðåíèÿ
'**********************************
Function edin(kod As Variant) As String
    Rem BAV çàìåíèë ìíîæåñòâåííûé âûáîð íà êîíñòðóêöèþ Case äëÿ óñêîðåíèÿ âûáîðà
    Select Case kod
        Case 1: edin = "ìì"
        Case 3: edin = "ì"
        Case 6: edin = "ã"
        Case 7: edin = "êã"
        Case 8: edin = "ò"
        Case 9: edin = "ë"
        Case 11: edin = "ñì2"
        Case 12: edin = "ñì"
        Case 13: edin = "ìì2"
        Case 14: edin = "ì2"
        Case 15: edin = "øò"
        Case 16: edin = "ì3"
        Case 17: edin = "äì"
        Case 18: edin = "êì"
    End Select
End Function
Sub Addnrow3(strf As Variant, flit As String, llit As String, r As Integer, st As Integer, mlen As Integer)
    Dim buf As String
    Dim strv As String
    Dim i As Integer
    Dim j As Integer
    Dim fpr As Integer
    i = 0
    fpr = 0

    If llit <> "" Then
        Excel.Range(flit & Format(r) & ":" & llit & Format(r)).Select
        Excel.Selection.Merge
    End If
    If Len(Format$(strf)) <= mlen Then
        Excel.Range(flit & Format(r)).Select
        Excel.ActiveCell.FormulaR1C1 = strf
        GoTo at
    End If
    For i = 0 To mlen - 1
        If Mid(strf, mlen - i, 1) = " " _
        Or Mid(strf, mlen - i, 1) = "/" _
        Or Mid(strf, mlen - i, 1) = "-" Then
            Excel.Range(flit & Format(r)).Select
            Excel.ActiveCell.FormulaR1C1 = Left(strf, mlen - i)
            fpr = 1
            Exit For
        End If
        Rem BAV çàìåíèë òðè If îäíèì äâà äðóãèõ çàêîììåíòèðîâàë
        'If Mid(strf, mlen - i, 1) = "/" Then
         '   Excel.Range(flit & Format(r)).Select
          '  Excel.ActiveCell.FormulaR1C1 = Left(strf, mlen - i)
           ' fpr = 1
        '    Exit For
        'End If
        'If Mid(strf, mlen - i, 1) = "-" Then
         '   Excel.Range(flit & Format(r)).Select
          '  Excel.ActiveCell.FormulaR1C1 = Left(strf, mlen - i)
           ' fpr = 1
            'Exit For
        'End If
    Next i
    If fpr = 0 Then
        Excel.Range(flit & Format(r)).Select
        Excel.ActiveCell.FormulaR1C1 = Left$(Format$(strf), mlen)
        i = 0
    End If
at:
    If st = 1 Then
        Excel.Selection.Font.Bold = True
    End If
    If Len(Format(strf)) > mlen Then
        fper = 1
        nss = ns
        If (nss > 24 And nlist = 1) Or (nss > 28 And nlist > 1) Then
            nrow
            
            nss = CDbl(frmMain.Text1.Text)
            
            r = w1
        Else
            
            nss = nss + 1
            
            'If r <> 20 Or r = 29 Then
          r = r + 1
         
            'Else
            'r = r + 2
            'End If
        End If
        buf = Right(Format(strf), Len(Format(strf)) - mlen + i)
        Addnrow3 buf, flit, llit, r, st, mlen
         q = r ' áûëî w
    End If
   
 End Sub
    
Public Function StringFromPointer(lpString As Long, lMaxLength As Long) As String
    Rem ôóíêöèÿ ïðåäíàçíà÷åíà äëÿ ïîëó÷åíèÿ ñòðîêè ïîäêëþ÷åíèÿ ê áàçå äàííûõ ïî äåñêðèïòîðó _
        õðàíèìîé â DLL ôóíêöèè
    Dim sRet As String
    Dim lret As Long
    Rem ïðîâåðêà áûë ëè ïåðåäàí äåñêðèïòîð
    If lpString = 0 Then
        StringFromPointer = ""
        Exit Function
    End If
    Rem ïðîâåðêà íà äîïóñòèìîñòü ñòðîêè
    If IsBadStringPtrByLong(lpString, lMaxLength) Then
        StringFromPointer = ""
        Exit Function
    End If
    sRet = Space$(lMaxLength)
    CopyMemory ByVal sRet, ByVal lpString, ByVal Len(sRet)
    If Err.LastDllError = 0 Then
        If InStr(sRet, Chr$(0)) > 0 Then sRet = Left$(sRet, InStr(sRet, Chr$(0)) - 1)
    End If
    StringFromPointer = sRet
End Function

Титов
Дата: 25.04.2011 14:02:50
в VB это исполнили ф таком виде!)) очень коряво много лишних не нужных запросов + ко всему выгружает одну ведомость около 5 минут!)))
Титов
Дата: 25.04.2011 14:13:49
ээээээм!? или вы все померли от ужеса!? или все озадачелись и фсем преглянулсо код!?
Anatoly Podgoretsky
Дата: 25.04.2011 14:20:33
Это портянка (портянко это длинный кусок материи).
Anatoly Podgoretsky
Дата: 25.04.2011 14:21:29
Титов
ээээээм!? или вы все померли от ужеса!? или все озадачелись и фсем преглянулсо код!?

Просмотрел только первых два экрана, потом плюнул
Титов
Дата: 25.04.2011 14:24:46
Anatoly Podgoretsky
Это портянка (портянко это длинный кусок материи).


расбиралсо-бы я в vb к вам бы не обратился а так для меня все что написано в этой "партянке" дремучий лес и не понятно что и от куда берется и как вносится