Проблемы с выгрузкой :(

[Sharky]

Всем привет! У меня трабла с выгрузкой формы, вроде всё нормально но при выходе из программы в VB она выгружается, но проект продолжает где-то работать. Я сделал дистриб и решил проверить на другой машине. Установил, запустил всё работает, закрыл прогу. Потом посмотрел в диспетчер задач, а она там висит. Подскажите пожалуйста хотя бы где искать ошибку, а то код просматриваю вроде всё нормально.

Заранее благодарен.

[RayShade]

Так код бы сюда и положил.

А так с ходу можно только сам знаешь что посоветовать

[Sharky]

Сам проект и выкладывать его весь думаю не имеет смысла. Но вообщем поясню. Писал я проект и добавил новую форму, после вызова в проге этой формы, прога закрываться не хочет. Ну я постараюсь кодом показать это чудо.

Значит так, вызов формы:

Код: Выделить всё

Dim frmX As frmEdit
Set frmX = New frmEdit
frmX.Show vbModal


Непосредственно код на самой форме:

Код: Выделить всё

Private lngLeft As Long
Private arrCol() As String
Private intSCR As Integer
Private lngRaznica As Long
Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOk_Click()
Dim intCount As Integer
Dim strColName As String
Dim strData As String
Dim rss As New ADODB.Recordset
Dim sql As String


sql = "Select * from Main where Unic = " & "'" & strFinder & "'"
procConnection sql, rss

For intCount = 0 To intFields - 2
    strColName = ReturnRealNameCol(Trim(lblArray(intCount).Caption))
    sql = Trim(rss.Fields(strColName).Type)
    strData = TestType(sql, Trim(txtArray(intCount).Text), Trim(lblArray(intCount).Caption))
    If strData <> "Fuck" Then
        UpdateNewValue strColName, strData
    End If
Next
Set rss = Nothing
Unload Me

End Sub

Private Sub Form_Load()
Dim fff As ADODB.Field
Dim intX As Integer
Dim lngTop As Long
Dim intTT As Long
Dim rs As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim sql As String
Dim intCount As Integer
Dim strColName As String
Dim intSize As String

'Çàãðóçêà êîíòðîëîâ
lngLeft = 1500
For intX = 1 To intFields - 2
    Load txtArray(intX)
    txtArray(intX).Left = lngLeft
    txtArray(intX).Visible = True
   
    Load lblArray(intX)
    lblArray(intX).Left = lngLeft
    lblArray(intX).Visible = True
   
    lngLeft = lngLeft + 1500
Next

'Íàñòðîéêà êîíòåéíåðà ñ ïîëÿìè
pctPole.Width = lngLeft
If pctContainer.Width < pctPole.Width Then
   intTT = pctContainer.Width - pctPole.Width
   pctPole.Left = intTT
End If

'Íàñòðîéêà ñêðîëà
scrHoriz.Min = 0
scrHoriz.Max = pctPole.ScaleWidth
pctPole.Left = 0

If pctContainer.ScaleWidth < pctPole.ScaleWidth Then
     lngRaznica = pctContainer.ScaleWidth - pctPole.ScaleWidth
End If

'Çàäà÷à íàäî ñäåëàòü âûáîðêó èç MAIN è çàáèòü äàííûìè ìàññèâ êîíòðîëîâ.
sql = "Select * from Main where Unic = " & "'" & strFinder & "'"
procConnection sql, rs

intSize = rs.Fields.count - 1

'Ñîçäà¸ì ìàññèâ ñ èìåíàìè ïîëåé
CreateArr

'Çàïîëíÿåì ïîëÿ â ñîîòâåòñâèè ñ Main
intSize = intSize - 1
For intCount = 0 To intSize
    If Trim(frmMain.dgUchrov.Columns(intCount).Caption) <> "ID" Then
        lblArray(intCount).Caption = Trim(frmMain.dgUchrov.Columns(intCount).Caption)
    End If
Next
Dim intCount2 As Integer

For intCount = 0 To intSize
        AddText intCount, arrCol(intCount2)
        txtArray(intCount).Enabled = AccessText(arrCol(intCount2))
    intCount2 = intCount2 + 1
Next

End Sub

Private Sub scrHoriz_Change()
'pctPole.Left = scrHoriz.Value
If scrHoriz.Value > intSCR Then
    pctPole.Left = pctPole.Left - 1500
    If pctPole.Left < lngRaznica Then
        pctPole.Left = lngRaznica
    End If
ElseIf scrHoriz.Value < intSCR Then
    pctPole.Left = pctPole.Left + 1500
    If pctPole.Left >= 0 Then
        pctPole.Left = 0
    End If
End If

If scrHoriz.Value > pctPole.ScaleWidth Then
    scrHoriz.Value = intSCR
ElseIf scrHoriz.Value < 0 Then
    scrHoriz.Value = 0
End If

intSCR = scrHoriz.Value
End Sub

Private Sub scrHoriz_Scroll()
If scrHoriz.Value > intSCR Then
    pctPole.Left = pctPole.Left - 1500
    If pctPole.Left < lngRaznica Then
        pctPole.Left = lngRaznica
    End If
ElseIf scrHoriz.Value < intSCR Then
    pctPole.Left = pctPole.Left + 1500
    If pctPole.Left >= 0 Then
        pctPole.Left = 0
    End If
End If

If scrHoriz.Value > pctPole.ScaleWidth Then
    scrHoriz.Value = intSCR
ElseIf scrHoriz.Value < 0 Then
    scrHoriz.Value = 0
End If

intSCR = scrHoriz.Value
End Sub

Private Sub AddText(NumArray As Integer, NameColCol As String)
Dim rs As New ADODB.Recordset
Dim sql As String

sql = "Select * from test where Unic = " & "'" & strFinder & "'"
procConnection sql, rs

On Error GoTo ErrNull
    txtArray(NumArray).Text = Trim(rs.Fields(NameColCol))
Exit Sub

ErrNull:
Select Case Err.Number
     Case 94
        txtArray(NumArray).Text = ""
     Case 13
End Select
End Sub
Private Sub CreateArr()
Dim sql As String
Dim rs As New ADODB.Recordset
Dim intArrReSize As Integer

sql = "SELECT COLUMN_NAME FROM information_schema.columns WHERE TABLE_NAME =" & "'" & "Main" & "'"
procConnection sql, rs

While Not rs.EOF
    intArrReSize = intArrReSize + 1
    rs.MoveNext
Wend

intArrReSize = intArrReSize - 1
ReDim arrCol(0 To intArrReSize)
rs.MoveFirst
intArrReSize = 0

While Not rs.EOF
    arrCol(intArrReSize) = rs.Fields("COLUMN_NAME")
    intArrReSize = intArrReSize + 1
    rs.MoveNext
Wend
End Sub
'Ìîæíî èëè íåò ðåäàêòèðîâàòü ïîëå
Private Function AccessText(NamePoly As String) As Boolean
Dim sql As String
Dim rs As New ADODB.Recordset

sql = "Select somevalue from " & Trim(strLogin) & _
    " where COLUMN_NAME = " & "'" & NamePoly & "'"
procConnection sql, rs

If Trim(rs.Fields("somevalue")) = 1 Then
    AccessText = True
    Exit Function
End If
AccessText = False
End Function

[/b]Ужас правда

Так вот, не знаю что и делать?

[Cyrax]

Значит так, вызов формы:

Код: Выделить всё

Dim frmX As frmEdit
Set frmX = New frmEdit
frmX.Show vbModal


вот в этом куске кода сбрасывай переменную frmX в Nothing, если эта переменная тебе больше не нужна после отображения формы.

Код: Выделить всё

Set frmX = Nothing

--------------
и вообще если это модальная форма, ее можно вызывать напрямую без объектной переменной:

Код: Выделить всё

frmEdit.Show vbModal