powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / TreeView для MS Office 64 bit
25 сообщений из 198, страница 2 из 8
TreeView для MS Office 64 bit
    #38247622
Фотография Программист-Любитель
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
5.1 из 2 Бэкап базы данных Ms SQL 2005
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38247623
Фотография Программист-Любитель
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
5.2 из 2
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38247886
Изерлонер
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Программист-Любитель,

при нажатии на кнопку "перестроить все" в форме frmIzdelieTreeAPI выдает ошибку 91 "Object variable or With block variable not set"
ссылается на
Код: vbnet
1.
Call Me.RebuildTree

. Что поправить нужно что бы заработало? Пытался перкомпилировать - не помогло.
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38247890
Фотография Программист-Любитель
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я сейчас ощибку отловлю. Пока просто походи по разным изделиям - дерево перестраивается ?
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38247893
Фотография Программист-Любитель
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не перестраивается. Буду исправлять.
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38247896
Изерлонер
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Программист-Любитель,

я спать. У нас три ночи.
Христос Воскресе!
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38247911
Фотография Программист-Любитель
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Воистину воскресе!

Починил. Для экономии выкладываю только измененный код формы frmIzdelieTreeAPI. Вклеишь весь код формы вместо имеющегося, ошибка исправится. Я неправильно очищал до нуля дерево.


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.
655.
656.
657.
658.
659.
660.
661.
662.
663.
664.
665.
666.
667.
668.
669.
670.
671.
672.
673.
674.
675.
676.
677.
678.
679.
680.
681.
682.
683.
684.
685.
686.
687.
688.
689.
690.
691.
692.
693.
694.
695.
696.
697.
698.
699.
700.
701.
702.
703.
704.
705.
706.
707.
708.
709.
710.
711.
712.
713.
714.
715.
716.
717.
Option Compare Database
Option Explicit

' Стандартный микрософсткий тривью
' Private WithEvents TreeView As MSComctlLib.TreeView
' Апишный тривью сделанный через MS Forms
Private WithEvents CustomTreeView As CustomTreeView
' Классы, обеспечивающий связь один-ко-многим для форм,
' замена стандартного микрософского LinkMasterFields, LinkChildFields
Dim lmcElement As LinkMasterChild ' для верхней субформы-карточки Текущий элемент
Dim lmcNode As LinkMasterChild ' для нижней субформы-грида Состав текущего узла

Private Sub Form_Load()

'    Закоментирован код задания данных стандартного микрософтского тривью
'    Set TreeView = Me.ctlTree.Object
'    Me.ctlTree.Visible = True
'    TreeView.Nodes.Clear
'    DoCmd.Save acForm, Me.Name
    
    ' Взвод таймера для выполнения всех действий по загрузке формы
    ' в момент, когда форма уже будет отображена на экране
    Me.TimerInterval = 1
    Me.OnTimer = "[Event Procedure]"

End Sub

Private Sub Form_Close()

' Make sure all objects are destroyed
    If Not CustomTreeView Is Nothing Then
        CustomTreeView.TerminateTree
    End If

End Sub

Private Sub Form_Timer()

    ' Отключение таймера, чтобы код процедуры выполнялся только один раз
    ' при загрузке формы
    Me.TimerInterval = 0
    Me.OnTimer = ""
    
    ' Задание источника данных формы
    ' параметры:
    ' имя вью из которого будет сделан SELECT FROM,
    ' условие для отбора данных WHERE
    ' поля, которые будут использованы в ORDER BY
    Dim sSQL As String: sSQL = modSYS.MakeSelectRecordSource( _
        "dbo.qrElement", "iTypeElementID=3", "sElementCode")
    Me.RecordSource = sSQL
    ' Вставание на нужную запись при открытии формы из других форм
    If Me.OpenArgs <> "" Then
        ApplyParameter (Me.OpenArgs)
    End If
    
End Sub

' Вставание на нужную запись
Public Function ApplyParameter(sParamString As String)

    Dim tv As TaggedValues
    Set tv = New TaggedValues
    tv.Text = sParamString
    If tv.Exists("iElementID") Then
        modForm.FindObjectByID Me, "iElementID", tv.item("iElementID")
    End If

End Function

' На событие текущей записи для текущего изделия надо перерисовать дерево
' и полную таблицу состава изделия
Private Sub Form_Current()

    If Me.RecordSource = "" Then Exit Sub
    If Me.Recordset.EOF Or Me.Recordset.BOF Then Exit Sub
    If Me.NewRecord Then Exit Sub
    
    Call Me.RebuildTree
    Call Me.RebuildFullTable

End Sub

' Принудительная перерисовка дерева при нажатии кнопки
Private Sub btnRebuildTree_Click()

    Call Me.RebuildTree

End Sub

' Принудительная перерисовка полной таблицы при нажатии кнопки
Private Sub btnRebuildFullTable_Click()
    
    Call Me.RebuildFullTable

End Sub

' Полное перестроение дерева структуры изделия от нуля
Public Sub RebuildTree()

    Dim sNodeElementAddress As String
    sNodeElementAddress = "#" & Me.iElementID & "#"
    
    ' Инициализация и задание параметров апишного тривью
    
    If Not CustomTreeView Is Nothing Then
        CustomTreeView.NodesClear
        Set CustomTreeView = Nothing
    End If

    Set CustomTreeView = New CustomTreeView
    With CustomTreeView
        ' Pass frame to the TreeControl of the treeview class
        Set .TreeControl = Me.ctlTree.Object
        ' Title for message boxes:
        .AppName = ""
        ' Set some properties
        .CheckBoxes = False
        .RootButton = True
        .LabelEdit = 0
        .Indentation = 20 * 0.75
        .NodeHeight = 16 * 0.75
        .ShowLines = True
    End With
    
    Dim tv As CustomTreeView
    Dim nodeRoot As CustomTreeNode
    Dim rsRoot As ADODB.Recordset

    Set tv = CustomTreeView

    Dim nCount As Long: nCount = -1
    Dim sSQL As String: sSQL = "SELECT * FROM qrNodeElement WHERE iElementID=" & Me.iElementID
    Dim rs As ADODB.Recordset

    modSQL.OpenRecordset rs, nCount, sSQL
    If rs.EOF And rs.BOF Then
        nCount = -1
        sSQL = "INSERT INTO dbo.NodeElement (iElementID) VALUES (" & Me.iElementID & ")"
        modSQL.ExecuteCommand nCount, sSQL
        nCount = -1
        sSQL = "SELECT * FROM qrNodeElement WHERE iElementID=" & Me.iElementID
        modSQL.OpenRecordset rs, nCount, sSQL
    End If

    ' Add a Root node with main and expanded icons and make it bold
    Set nodeRoot = tv.AddRoot( _
        Key:="ROOT", _
        Text:=Me.sElementCode & " " & Me!sElementName & " (" & Me!iTypeElementID.Column(1) & ")", _
        vImageMain:="FolderClosed", vImageExpanded:="FolderOpen")
    nodeRoot.Bold = True
    nodeRoot.Tag = rs!iNodeElementID
    
    ' Рекурсивный обход дерева и загрузка всех узлов в память, но пока не в кустомный контрол
    Call LoadLevel(tv, nodeRoot, Me!iElementID)
    
    ' Заполнение кустомного контрола элементами по данным загруженного дерева
    tv.PopulateTree
    Me.ctlTree.SetFocus
    ' Активация корневого узла, загрузка в субформы его данных
    CustomTreeView_Click nodeRoot

End Sub

' Рекурсивная процедура загрузки текущего узла
Public Function LoadLevel(tv, nodeParent, iElementID)

    Dim nCount As Long: nCount = -1
    Dim sSQL As String: sSQL = "SELECT * FROM qrNodeElement WHERE iElementID_Parent=" & iElementID
    Dim rs As ADODB.Recordset
    modSQL.OpenRecordset rs, nCount, sSQL
    
    While Not rs.EOF
    
'       Закоментирован код загрузки узла в микрософтский тривью
'       Dim node As node
'       Set node = tv.Nodes.Add( _
'           relative:=nodeParent.Index, relationship:=tvwChild, _
'           Key:="NODE" & CStr(rs!iNodeElementID), _
'           Text:=rs!sElementCode & " " & rs!sElementName & " (" & rs!sTypeElementName & ")")
'       node.Tag = rs!iNodeElementID
'       node.Expanded = True

'       Загрузка узла в кустомный тривью
        Dim node As CustomTreeNode
        ' Add node
        Dim strKey As String, strCaption As String
        strKey = "NODE" & CStr(rs!iNodeElementID)
        strCaption = rs!sElementCode & " " & rs!sElementName & " (" & rs!sTypeElementName & ")"
        Set node = nodeParent.AddChild(Key:=strKey, Text:=strCaption)
        node.Tag = rs!iNodeElementID
        ' Рекурсивный вызов самой себя для загрузки детей текущего узла
        Call LoadLevel(tv, node, rs!iElementID)
        ' Переход к следующему соседнему узлу на том же уровне
        rs.MoveNext
    Wend
    
End Function

'    Закоментирован код обработки нажатия узла стандартного микрософтского тривью
'    Private Sub TreeView_NodeClick(ByVal n As MSComctlLib.node)
'
'        Me.iNodeElementID = n.Tag
'        Me.iElementID_Link = DLookup("iElementID", "qrNodeElement", "iNodeElementID=" & Me.iNodeElementID)
'        Dim vTypeElementID: vTypeElementID = DLookup("iTypeElementID", "qrElement", "iElementID=" & Me.iElementID_Link)
'
'        Me.lblElement.Caption = "Текущий элемент [" & n.Text & "]"
'        If Me.frmElement.SourceObject = "" Then
'            Me.frmElement.SourceObject = "frmElement"
'        End If
'        If lmcElement Is Nothing Then
'            Set lmcElement = New LinkMasterChild
'            lmcElement.SetMasterChildParameters _
'                Me, Me.frmElement.Form, _
'                "iElementID_Link", "iElementID", _
'                "SELECT * FROM dbo.qrElement", True
'        Else
'            lmcElement.RequeryChild
'        End If
'
'        Me.lblNodeElement.Caption = "Состав текущего узла [" & n.Text & "]"
'        Select Case vTypeElementID
'        Case 1
'            Me.grNodeElement.SourceObject = ""
'            Set lmcNode = Nothing
'        Case 2, 3:
'            If Me.grNodeElement.SourceObject = "" Then
'                Me.grNodeElement.SourceObject = "grNodeElement"
'                With Me.grNodeElement.Form
'                    Dim ctl As Control
'                    For Each ctl In .Controls
'                        On Error Resume Next
'                        Select Case ctl.Tag
'                        Case "NODE":                    ctl.ColumnHidden = False
'                        Case "ELEMENT":                 ctl.ColumnHidden = False
'                        Case "TYPE_ELEMENT":            ctl.ColumnHidden = True
'                        Case "ELEMENT_PARENT":          ctl.ColumnHidden = True
'                        Case "ELEMENT_PARENT_HIDDEN":   ctl.ColumnHidden = True
'                        Case "TYPE_ELEMENT_PARENT":     ctl.ColumnHidden = True
'                        End Select
'                    Next ctl
'                End With
'            End If
'            If lmcNode Is Nothing Then
'                Set lmcNode = New LinkMasterChild
'                lmcNode.SetMasterChildParameters _
'                    Me, Me.grNodeElement.Form, _
'                    "iElementID_Link", "iElementID_Parent", _
'                    "SELECT * FROM dbo.qrNodeElement", True
'            Else
'                lmcNode.RequeryChild
'            End If
'        End Select
'
'    End Sub

' Обработка нажатия узла кустомного тривью
' Загрузка в субформы данных текущего узла
Private Sub CustomTreeView_Click(n As CustomTreeNode)
    
        Me.iNodeElementID = n.Tag
        Me.iElementID_Link = DLookup("iElementID", "qrNodeElement", "iNodeElementID=" & Me.iNodeElementID)
        Dim vTypeElementID: vTypeElementID = DLookup("iTypeElementID", "qrElement", "iElementID=" & Me.iElementID_Link)

        Me.lblElement.Caption = "Текущий элемент [" & n.Text & "]"
        If Me.frmElement.SourceObject = "" Then
            Me.frmElement.SourceObject = "frmElement"
        End If
        If lmcElement Is Nothing Then
            Set lmcElement = New LinkMasterChild
            lmcElement.SetMasterChildParameters _
                Me, Me.frmElement.Form, _
                "iElementID_Link", "iElementID", _
                "SELECT * FROM dbo.qrElement", True
        Else
            lmcElement.RequeryChild
        End If

        Me.lblNodeElement.Caption = "Состав текущего узла [" & n.Text & "]"
        Select Case vTypeElementID
        Case 1
            Me.grNodeElement.SourceObject = ""
            Set lmcNode = Nothing
        Case 2, 3:
            If Me.grNodeElement.SourceObject = "" Then
                Me.grNodeElement.SourceObject = "grNodeElement"
                With Me.grNodeElement.Form
                    Dim ctl As Control
                    For Each ctl In .Controls
                        On Error Resume Next
                        Select Case ctl.Tag
                        Case "NODE":                    ctl.ColumnHidden = False
                        Case "ELEMENT":                 ctl.ColumnHidden = False
                        Case "TYPE_ELEMENT":            ctl.ColumnHidden = True
                        Case "ELEMENT_PARENT":          ctl.ColumnHidden = True
                        Case "ELEMENT_PARENT_HIDDEN":   ctl.ColumnHidden = True
                        Case "TYPE_ELEMENT_PARENT":     ctl.ColumnHidden = True
                        End Select
                    Next ctl
                End With
            End If
            If lmcNode Is Nothing Then
                Set lmcNode = New LinkMasterChild
                lmcNode.SetMasterChildParameters _
                    Me, Me.grNodeElement.Form, _
                    "iElementID_Link", "iElementID_Parent", _
                    "SELECT * FROM dbo.qrNodeElement", True
            Else
                lmcNode.RequeryChild
            End If
        End Select

End Sub

Public Sub RebuildFullTable()

    '
    '    Этот код перестал быть нужен после перезода на АДП
    '    и создания запроса qrNodeElement2, выполняющего рекурсивный обход
    '    всего дереваи вычисялющего поле полного адреса sNodeElementAddress
    '
    
    '    Dim sNodeElementAddress As String
    '    sNodeElementAddress = "#" & Me.iElementID & "#"
    
    '    Dim cnn As ADODB.Connection, rs As ADODB.Recordset
    '    Set cnn = CurrentProject.Connection
    '    Set rs = New ADODB.Recordset
    '    rs.CursorLocation = adUseClient: rs.CursorType = adOpenStatic: rs.LockType = adLockBatchOptimistic
    '    rs.Open "SELECT * FROM dbo.qrNodeElement WHERE iElementID=" & Me.iElementID, cnn
    '    If rs.EOF And rs.BOF Then
    '        rs.AddNew
    '        rs!iElementID = Me.iElementID
    '        rs.Update
    '    End If
    '    rs.Close: Set rs = Nothing
    
    '    Set rs = New ADODB.Recordset
    '    rs.CursorLocation = adUseClient: rs.CursorType = adOpenStatic: rs.LockType = adLockBatchOptimistic
    '    rs.Open "SELECT * FROM dbo.qrNodeElement WHERE iElementID=" & Me.iElementID, cnn
    '    While Not rs.EOF
    '        CurrentProject.Connection.Execute _
    '            "UPDATE dbo.NodeElement " & _
    '            "SET sNodeElementAddress='" & sNodeElementAddress & "' " & _
    '            "WHERE iNodeElementID=" & rs!iNodeElementID
    '        Call MakeLevelAddress(rs!iElementID, sNodeElementAddress)
    '        rs.MoveNext
    '    Wend
    '    rs.Close: Set rs = Nothing
    
    Me.lblFullTable.Caption = "Полный состав всего изделия [" & Me!sElementName & "]"
    Me.grFullTable.SourceObject = "grNodeElement"
    With Me.grFullTable.Form
        ' Управление видимостью столбцов, скрытие части из них
        ' чтобы на экран не выводились внутренние коды, айдишники,
        ' необходимые для набора данных, но не нужные для отображения
        Dim ctl As Control
        For Each ctl In .Controls
            On Error Resume Next
            Select Case ctl.Tag
            Case "NODE":                    ctl.ColumnHidden = False
            Case "ELEMENT":                 ctl.ColumnHidden = False
            Case "TYPE_ELEMENT":            ctl.ColumnHidden = True
            Case "ELEMENT_PARENT":          ctl.ColumnHidden = False
            Case "ELEMENT_PARENT_HIDDEN":   ctl.ColumnHidden = True
            Case "TYPE_ELEMENT_PARENT":     ctl.ColumnHidden = True
            End Select
        Next ctl
    End With
    ' Задание источника данных структуры Полного состава
    Me.grFullTable.Form.RecordSource = _
        "SELECT * FROM dbo.qrNodeElement2 " & _
        "WHERE iElementID_Root=" & Me.iElementID & " " & _
        "ORDER BY iElementID_Root, iNodeElementID"
    Me.grFullTable.Form.UniqueTable = "NodeElement"

End Sub

'    Необходимость в пересчете адреса отпала после перехода на адп и использования рекурсивного запроса
'    Public Function MakeLevelAddress(iElementID, sNodeElementAddress)
'
'        Dim cnn As ADODB.Connection
'        Set cnn = CurrentProject.Connection
'        Dim rs As ADODB.Recordset
'        Set rs = New ADODB.Recordset
'        rs.CursorLocation = adUseClient: rs.CursorType = adOpenStatic: rs.LockType = adLockBatchOptimistic
'        rs.Open "SELECT * FROM qrNodeElement WHERE iElementID_Parent=" & iElementID, cnn
'
'        While Not rs.EOF
'            CurrentProject.Connection.Execute _
'                "UPDATE dbo.NodeElement " & _
'                "SET sNodeElementAddress='" & sNodeElementAddress & rs!iElementID & "#' " & _
'                "WHERE iNodeElementID=" & rs!iNodeElementID
'            Call MakeLevelAddress(rs!iElementID, sNodeElementAddress & rs!iElementID & "#")
'            rs.MoveNext
'        Wend
'
'    End Function

' Кнопка Открыть карточку элемента
' В зависимости от того, какого типа элемент в субформе Состав текущего узла
' открывается одна из трех форм - карточка изделия, сборки или детали
Private Sub btnOpenElementCard_Click()

    On Error Resume Next
    Me.grNodeElement.SetFocus
    DoCmd.RunCommand acCmdSelectRecord
    On Error GoTo 0
    
    If Me.grNodeElement.SourceObject <> "" Then
        Dim vElementID, vTypeElementID
        modForm.GetObjectID Me.grNodeElement.Form, "iElementID", vElementID
        modForm.GetObjectID Me.grNodeElement.Form, "iTypeElementID", vTypeElementID
        If vTypeElementID > 0 And vElementID > 0 Then
            Dim sParamter As String
            sParamter = "iElementID=" & vElementID
            Dim sFormName As String, frm As Form
            Select Case vTypeElementID
            Case 1: sFormName = "frmDetal"
            Case 2: sFormName = "frmSborka"
            Case 3: sFormName = "frmIzdelie"
            End Select
            If modUtil.IsLoaded(sFormName) Then
                ' Если форма уже открыта, то ее надо поставить на нужную запись
                Set frm = Forms(sFormName)
                frm.ApplyParameter "iElementID=" & vElementID
                frm.SetFocus
            Else
                ' Если форма еще не открыта, то надо передать ей айди,
                ' на который она должна встать в качестве аргумента
                DoCmd.OpenForm _
                    sFormName, acNormal, , , acFormEdit, acWindowNormal, _
                    "iElementID=" & vElementID
                Set frm = Forms(sFormName)
                frm.SetFocus
            End If
        End If
    End If

End Sub

' Нажатие кнопки Добавить новый элемент
' При этом выполняется два действия
' 1. Создание нового элемента в таблице элементов
' 2. Вставка этого элемента в текущий узел изделия
Private Sub btnAddElement_Click()

    If Me.grNodeElement.SourceObject <> "" Then
        DoCmd.OpenForm "dlgAddElement", acNormal, , , acFormEdit, acDialog
        Dim dlg As Form_dlgAddElement
        Set dlg = Forms!dlgAddElement
        If dlg.bOK Then
        
            ' 1. Добавление нового элемента в таблицу элементов
            Dim vTypeElementID, vElementCode, vElementName, vElementNote, _
                vElementWeight, vElementCoverage, vElementElectricLight
                vTypeElementID = dlg.iTypeElementID
                vElementCode = dlg.sElementCode
                vElementName = dlg.sElementName
                vElementNote = dlg.sElementNote
                vElementWeight = dlg.dbElementWeight
                vElementCoverage = dlg.dbElementCoverage
                vElementElectricLight = dlg.sElementElectricLight
            ' Специальный вставлятор данных в таблицу
            Dim insertElement As InsertSQL
            Set insertElement = New InsertSQL
            insertElement.Constructor sTableName:="Element", sTableOfDecription:="элементов"
            insertElement.AddFieldValue "iTypeElementID", vTypeElementID
            insertElement.AddFieldValue "sElementCode", vElementCode
            insertElement.AddFieldValue "sElementName", vElementName
            insertElement.AddFieldValue "sElementNote", vElementNote
            Select Case vTypeElementID
            Case 1
                insertElement.AddFieldValue "dbElementWeight", vElementWeight
                insertElement.AddFieldValue "dbElementCoverage", vElementCoverage
                insertElement.AddFieldValue "sElementElectricLight", vElementElectricLight
            Case 2
            Case 3
            End Select
            ' Выполнение оператора вставки и получение айди - ПК автосчетчика свежевставленной записи
            Dim vNodeID: vNodeID = insertElement.Execute
            
            ' Еще один вставлятор данных, теперь в таблицу структуры изделия
            ' текущий узел, в который будет добавлен элемент, хранится в поле формы Me!iElementID_Link
            Set insertElement = New InsertSQL
            insertElement.Constructor sTableName:="NodeElement", sTableOfDecription:="состав"
            insertElement.AddFieldValue "iElementID", vNodeID
            insertElement.AddFieldValue "iElementID_Parent", Me!iElementID_Link
            insertElement.AddFieldValue "nNodeElementCount", 1
            Dim vNodeElementID: vNodeElementID = insertElement.Execute
        
            Dim tv As CustomTreeView: Set tv = CustomTreeView
            Dim nodeParent As CustomTreeNode: Set nodeParent = tv.ActiveNode
            Dim node As CustomTreeNode
            Set node = nodeParent.AddChild(Key:="NODE" & CStr(vNodeElementID), Text:=CStr(vElementName))
            
            ' Закоментирован код вставки в стандартный микрософтский тривью
            '    Set node = tv.Nodes.Add( _
            '        relative:=nodeParent.Index, relationship:=tvwChild, _
            '        Key:="NODE" & CStr(vNodeElementID), Text:=vElementName)
            
            node.Tag = vNodeElementID
            '   TreeView_NodeClick nodeParent
            
            ' После вставки надо обновить субформу Состав текущего узла,
            ' чтобы в нем отобразился новый элемент
            Me.grNodeElement.Requery
            ' Позиционируем субформу на новый элемент
            Me.grNodeElement.Form.Recordset.Find "iNodeElementID=" & vNodeElementID
            Me.grNodeElement.Form!iElementID.Requery
        End If
        DoCmd.Close acForm, "dlgAddElement", acSaveNo
    End If
    
End Sub

' ВСЕ ФОРМЫ ДОЛЖНЫ БЫТЬ РЕЗИНОВЫМИ
Private Sub Form_Resize()
Me.Painting = False

    ' Верхняя часть формы до табстрипа резинится без проблем
    Dim h, w
    w = (Me.InsideWidth - 100 _
    - Me.lblElementID.Width - 100 _
    - Me.lblTypeElementID.Width - 100 _
    - Me.lblElementCode.Width - 100 _
    - Me.lblElementName.Width - 100) * 0.125
    If w < 300 Then w = 300
    
    With Me.lblElementID
        .Top = 200
        .Left = 100
    End With
    With Me.iElementID
        .Top = Me.lblElementID.Top
        .Left = Me.lblElementID.Left + Me.lblElementID.Width
        .Width = w
    End With
    With Me.lblTypeElementID
        .Top = Me.iElementID.Top
        .Left = Me.iElementID.Left + Me.iElementID.Width + 100
    End With
    With Me.iTypeElementID
        .Top = Me.lblTypeElementID.Top
        .Left = Me.lblTypeElementID.Left + Me.lblTypeElementID.Width
        .Width = w
    End With
    With Me.lblElementCode
        .Top = Me.iTypeElementID.Top
        .Left = Me.iTypeElementID.Left + Me.iTypeElementID.Width + 100
    End With
    With Me.sElementCode
        .Top = Me.lblElementCode.Top
        .Left = Me.lblElementCode.Left + Me.lblElementCode.Width
        .Width = w
    End With
    With Me.lblElementName
        .Top = Me.sElementCode.Top
        .Left = Me.sElementCode.Left + Me.sElementCode.Width + 100
    End With
    With Me.sElementName
        .Top = Me.lblElementName.Top
        .Left = Me.lblElementName.Left + Me.lblElementName.Width
        .Width = 5 * w
    End With
    
    ' Чтобы отрезинить табстрип сначала надо согнать все контролы, расположенные на нем
    ' в его правый верхний угол. Правила определения контролов на табстрипе:
    ' 1. У всех контролов табстрипа должно быть в таге 'tab'
    ' 2. Контролы, которые растягиваются по вертикали в пределах табстрипа, должны имтеть в таге 'height'
    ' 3. Контролы, которые растягиваются по горизонтали в пределах табстрипа, должны имтеть в таге 'width'
    ' отдельный ключевые коды разделяются точкой с запятой: 'tab;height;width'
    Dim t, l
    t = Me.lblElementID.Top + Me.lblElementID.Height + 200
    l = Me.lblElementID.Left
    modForm.SqueezeControls Me, t + 600, l + 300
    
    ' Позиционирование на форме табстрипа
    With Me.tabStrip
        .Height = 0
        .Width = 0
        .Top = t
        .Left = l
        h = Me.InsideHeight - .Top - 100
        If h < 1000 Then h = 1000
        w = Me.InsideWidth - .Left - 100
        If w < 1000 Then w = 1000
        .Height = h
        .Width = w
    End With

    ' Позиционирование на форме контролов в пределах табстрипа
    
    ' Вкладка Структура изделия tabTree
    Dim hh, ww
    hh = Me.tabTree.Height / 3
    ww = Me.tabTree.Width / 3
    If ww < 1000 Then ww = 1000
    If hh < 1000 Then hh = 1000
    
    With Me.lblTree
        .Top = Me.tabTree.Top + 100
        .Left = Me.tabTree.Left
    End With
    With Me.ctlTree
        .Top = Me.lblTree.Top + Me.lblTree.Height + 100
        .Left = Me.lblTree.Left
        Dim hhh
        hhh = Me.tabTree.Top + Me.tabTree.Height - .Top
        If hhh < 0 Then hhh = 0
        .Height = hhh
        .Width = ww
    End With
    With Me.btnRebuildTree
        .Top = Me.lblTree.Top - (.Height - Me.lblTree.Height)
        l = Me.ctlTree.Left + Me.ctlTree.Width - .Width
        If l < Me.ctlTree.Left Then l = Me.ctlTree.Left
        .Left = l
    End With
    
    With Me.lblElement
        .Width = 0
        .Top = Me.lblTree.Top
        .Left = Me.ctlTree.Left + Me.ctlTree.Width + 100
        Dim www
        www = Me.tabTree.Left + Me.tabTree.Width - .Left
        If www < 1000 Then www = 1000
        .Width = www
    End With
    With Me.frmElement
        .Width = 0
        .Top = Me.lblElement.Top + Me.lblElement.Height + 100
        .Left = Me.lblElement.Left
        .Height = hh
        ww = Me.tabTree.Left + Me.tabTree.Width - .Left
        If ww < 1000 Then ww = 1000
        .Width = ww
    End With
    ' Примечание: очень полезный эффект аксеса
    ' При задании размера субформы frmElement, являющейса карточкой,
    ' в ней тоже тоже будет вызываться код ресайзинга
    ' и она расположит свои контролы так,
    ' чтобы красиво заполнять всю предоставленную ей площадь
    
    With Me.lblNodeElement
        .Width = 0
        .Top = Me.frmElement.Top + Me.frmElement.Height + 200
        .Left = Me.frmElement.Left
        Dim www2
        www2 = www - 100 - Me.btnOpenElementCard.Width - 50 - Me.lblOpenElementCard.Width - 100 - Me.btnAddElement.Width - 50 - Me.lblAddElement.Width
        If www2 < 1000 Then www2 = 1000
        .Width = www2
    End With
    With Me.btnOpenElementCard
        .Top = Me.lblNodeElement.Top - (.Height - Me.lblNodeElement.Height) / 2 - 30
        .Left = Me.lblNodeElement.Left + Me.lblNodeElement.Width + 100
    End With
    With Me.lblOpenElementCard
        .Top = Me.btnOpenElementCard.Top
        .Left = Me.btnOpenElementCard.Left + Me.btnOpenElementCard.Width + 50
    End With
    With Me.btnAddElement
        .Top = Me.lblOpenElementCard.Top
        .Left = Me.lblOpenElementCard.Left + Me.lblOpenElementCard.Width + 100
    End With
    With Me.lblAddElement
        .Top = Me.btnAddElement.Top
        .Left = Me.btnAddElement.Left + Me.btnAddElement.Width + 50
    End With
    With Me.grNodeElement
        .Width = 0
        .Top = Me.lblNodeElement.Top + Me.lblNodeElement.Height + 100
        .Left = Me.lblNodeElement.Left
        hh = Me.tabTree.Top + Me.tabTree.Height - .Top
        If hh < 1000 Then hh = 1000
        .Height = hh
        .Width = www
    End With
    
    ' Вкладка Полный состав в виде единой таблицы tabFullTable
    ww = Me.tabFullTable.Width
    If ww < 1000 Then w = 1000
    With Me.lblFullTable
        .Top = Me.tabFullTable.Top + 100
        .Left = Me.tabFullTable.Left
    End With
    With Me.grFullTable
        .Top = Me.lblFullTable.Top + Me.lblFullTable.Height + 100
        .Left = Me.lblFullTable.Left
        hhh = Me.tabFullTable.Top + Me.tabFullTable.Height - .Top
        If hhh < 0 Then hhh = 0
        .Height = hhh
        .Width = ww
    End With
    With Me.btnRebuildFullTable
        .Top = Me.lblFullTable.Top - (.Height - Me.lblFullTable.Height)
        l = Me.grFullTable.Left + Me.grFullTable.Width - .Width
        If l < Me.grFullTable.Left Then l = Me.grFullTable.Left
        .Left = l
    End With
        
    ' Вкладка Примечание
    With Me.lblElementNote
        .Top = Me.tabNote.Top
        .Left = Me.tabNote.Left
    End With
    With Me.sElementNote
        .Top = Me.lblElementNote.Top + Me.lblElementNote.Height + 100
        .Left = Me.lblElementNote.Left
        hhh = Me.tabNote.Top + Me.tabNote.Height - .Top
        If hhh < 0 Then hhh = 0
        .Height = hhh
        .Width = Me.tabNote.Width
    End With
        
Me.Painting = True
End Sub

...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38247922
СхБд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Программист-ЛюбительИзвините, спойлер не туда вставил... поф
спасибищще!
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248483
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Приветствую!!

еще раз ОГРОМНОЕ спасибо за помощь и подсказки!!!

Сейчас скачаю и посмотрим...

кстати первая ссылка на скачивание не работает ( [14257650] ), там где " К сообщению приложен файл (Схема данных Детали, Сборки, Изделия.pdf - 69Kb) cкачать "

пишет :
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248486
П-Л
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Только что скачал без проблем. Дело в твоем броузере. Насколько понимаю, у Изерлонера тоже скачалось.
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248490
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
П-Л,

работаю с роутера фрештел, никаких проблем ни разу не было, все скачалось, только вот указанное не могу скачать, выставь пожалуйста еще раз...
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248494
П-Л
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не смогу. Может кто из завсегдатаев не поленится скачать и приложить заново ?
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248506
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
П-Л,

что то я совсем подзабыл, не получается развернуть бэкап скл сервера...
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248507
////
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248508
П-Л
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Спасибо, добрый человек!
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248511
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
////,

Да что ж за день то сегодня такой.....

не получается скачать, сообщение такое же...

может на почту бросишь.... не сочти за труд..... СПАСИБО!!!!

Alex999kon@mail.ru
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248512
П-Л
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alex999konП-Л,

что то я совсем подзабыл, не получается развернуть бэкап скл сервера...
Читай бол. Галку не поставил Перезаписать текущее содержмимое той базы что уже есть у тебя сейчас на сервере.
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248515
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
П-Л,

как всегда, позабыл, чаще надо продолжать заниматься проектом, текущие дела достали.... некогда...

все получилось, пробую, а скачать пдф так и не получилось, ни через роутер ни через прокси, странно что все остальное качать дает...
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248516
П-Л
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Развернешь базу - в ней будет диаграмма данных, которая в ПДф, так что он как таковой тебе и не нужен.
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248521
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
П-Л,

чето не догадался, спасибо, кстати пробую открывать формы выдает сообщения об ошибках..
сейчас работаю под вин 7-32 с скл 2008 р2, вот скрин...
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248526
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вы все будете смеяться но из под YANDEXA такое же сообщение...
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248531
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
а вот EXPLORER скачал, и даже показал...

ну да ладно, отвлекаемся...

насчет ошибок открытия форм-
думается мне что нужно перекомпилировать только вот не знаю как это по-правильнее что-ли, подскажите... плиз...
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248535
П-Л
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Надо проверить в вба все ссылки. Все ссылки стандартные для а2003. Решить проблему, если есть миссинг. Проверить, компилируется ли проект.

Покажи принтскрин окна ссылок.
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248540
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
П-Л,

пока пробовал вот что получил:
...
Рейтинг: 0 / 0
TreeView для MS Office 64 bit
    #38248541
Фотография alex999kon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alex999kon,

насчет окна ссылок, имеется ввиду наверное в отладчике tools - reference? если я правильно понял...
...
Рейтинг: 0 / 0
25 сообщений из 198, страница 2 из 8
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / TreeView для MS Office 64 bit
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]