[Jerrick]

//........................frpPrintItog.frm.......... ...........

Код:

Attribute VB_Name = "frmPrintItog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim cSopr As SoprInfo

Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

Private Sub Form_Load()
  cSopr.Npl = 0
End Sub

Private Sub mnu_open_Click()
Dim i%, j%, k%
Dim s$
Dim SumVes As Single
On Error GoTo Cansel
  
  If txt(1).Text <> "" Then
    dlg1.CancelError = True                                     'установим, чтобы возникала ошибка при щелчке по кнопке Cansel
    dlg1.InitDir = App.path & "\Norma\"
    dlg1.Filter = "Файлы данных (*.bin)|*.bin"
    dlg1.Flags = cdlOFNFileMustExist & cdlOFNHideReadOnly
    dlg1.DialogTitle = "Загрузить файл"
    dlg1.ShowOpen
    
    Mnu_Open.Enabled = False
    Mnu_Print.Enabled = True
    Mnu_Trans.Enabled = True
    
    LoadSost dlg1.FileName, cSost
    cSost.Sopr = cSopr
  
    Label6.Caption = "Дата взвешивания цех:           " & Format(cSost.Ves_in(1).DATA, "dd.mm.yyyy")
    Label7.Caption = "Время взвешивания в цех:      " & Format(cSost.Ves_in(1).DATA, "hh:NN:ss")
    Label8.Caption = "Дата взвешивания из цеха:      " & Format(cSost.Ves_out(1).DATA, "dd.mm.yyyy")
    Label2.Caption = "Время взвешивания из цеха:  " & Format(cSost.Ves_out(1).DATA, "hh:NN:ss")
    
    For j = 1 To cSost.Sopr.Npl
      SumVes = 0
      For i = cSost.Sopr.Pl(j).N_osi To cSost.Sopr.Pl(j).N_osi + cSost.Sopr.Pl(j).KolTel * 6 - 1
        SumVes = SumVes + cSost.Ves_in(i).Ves - cSost.Ves_out(i).Ves
      Next i
      cSost.Sopr.Pl(j).Ves = SumVes
      txt(-1 + 6 * j) = Format(SumVes, "000.0")
    Next j
    
    s = Mid$(dlg1.FileName, InStrRev(dlg1.FileName, "\") + 1, Len(dlg1.FileName) - InStrRev(dlg1.FileName, "\") - 4)
    
    Open dlg1.FileName For Binary As #1
      Put #1, , cSost
    Close #1

    Open App.path & "\ASUTP\" & Format(Now, "ddmmyyhhNNss") & ".bin" For Binary As #1
      Put #1, , cSost
    Close #1

    MoveFile dlg1.FileName, App.path & "\Печать\" & s & ".bin"
    MoveFile App.path & "\Norma\" & s & ".xls", App.path & "\Печать\" & s & ".xls"
  End If
  
  Exit Sub
Cansel:
  If Err.Number = cdlCancel Or Err.Number = 0 Then
    Exit Sub
  Else
    MsgBox Err.Description
  End If
End Sub

Private Sub mnu_exit_Click()
  Unload frmDonixEgy
  Unload Me
End Sub

Private Sub mnuBD_Click()
  If conState Then
    frmDonixEgy.Show vbModal
  Else
    Exit Sub
  End If
End Sub

Private Sub mnu_zapis_Click()
Dim ans As Long, i As Integer, j As Integer

On Error GoTo Cansel

  txtCover2.Visible = False
  If Len(txtCover2.Text) > 0 Then txtCover2.Text = ""
  
  While Len(Operator) = 0
     Operator = InputBox("ВВЕДИТЕ ВАШУ ФАМИЛИЮ", "Ф.И.О. ОПЕРАТОРА", Operator)
  Wend
  Label4.Caption = " Ф.И.О. оператора:  " & Operator
  
  While cSopr.Npl < 1 Or cSopr.Npl > 3
    cSopr.Npl = Val(InputBox("ВВЕДИТЕ КОЛИЧЕСТВО ПЛАВОК ", "КОЛИЧЕСТВО  ПЛАВОК", 2))
  Wend
    
  If Not conState Then
    ans = 0
    While ans <> 2
      cSopr.Pl(1).Npl = InputBox("ВВЕДИТЕ НОМЕР ПЕРВОЙ ПЛАВКИ (7 знаков)", " НОМЕР ПЛАВКИ")
      If Len(cSopr.Pl(1).Npl) <> 7 Then ans = MsgBox("НЕПРАВИЛЬНЫЙ НОМЕР ПЛАВКИ", 53, "ОШИБКА") Else ans = 2
    Wend
    If cSopr.Npl > 1 Then
      ans = 0
      While ans <> 2
        cSopr.Pl(2).Npl = InputBox("ВВЕДИТЕ НОМЕР ВТОРОЙ ПЛАВКИ (7 знаков)", " НОМЕР ПЛАВКИ")
        If Len(cSopr.Pl(2).Npl) <> 7 Then ans = MsgBox("НЕПРАВИЛЬНЫЙ НОМЕР ПЛАВКИ", 53, "ОШИБКА") Else ans = 2
      Wend
    End If
    If cSopr.Npl > 2 Then
      ans = 0
      While ans <> 2
        cSopr.Pl(3).Npl = InputBox("ВВЕДИТЕ НОМЕР ТРЕТЬЕЙ ПЛАВКИ (7 знаков)", " НОМЕР ПЛАВКИ")
        If Len(cSopr.Pl(3).Npl) <> 7 Then ans = MsgBox("НЕПРАВИЛЬНЫЙ НОМЕР ПЛАВКИ", 53, "ОШИБКА") Else ans = 2
      Wend
    End If
    
  End If
  
  cSopr.Pl(1).KolTel = Val(InputBox("ВВЕДИТЕ ЧИСЛО ТЕЛЕЖЕК" & Chr(13) & "В ПЕРВОМ СОСТАВЕ", " ЧИСЛО ТЕЛЕЖЕК", 5))
  If cSopr.Npl > 1 Then cSopr.Pl(2).KolTel = Val(InputBox("ВВЕДИТЕ ЧИСЛО ТЕЛЕЖЕК" & Chr(13) & "ВО ВТОРОМ СОСТАВЕ", " ЧИСЛО ТЕЛЕЖЕК", 5))
  If cSopr.Npl > 2 Then cSopr.Pl(3).KolTel = Val(InputBox("ВВЕДИТЕ ЧИСЛО ТЕЛЕЖЕК" & Chr(13) & "В ТРЕТЬЕМ СОСТАВЕ", " ЧИСЛО ТЕЛЕЖЕК", 5))
  
  cSopr.Pl(1).N_osi = 9
  cSopr.Pl(2).N_osi = cSopr.Pl(1).N_osi + cSopr.Pl(1).KolTel * 6
  cSopr.Pl(3).N_osi = cSopr.Pl(2).N_osi + cSopr.Pl(2).KolTel * 6
  
  For i = 0 To 6
    vLine(i).Y2 = hLine(1 + cSopr.Npl).Y1
  Next i
  
  For j = 1 To cSopr.Npl
    For i = 0 To 5
      txt((j - 1) * 6 + i).Visible = True
    Next i
    hLine(1 + j).Visible = True
  Next j
  
  If conState Then
    For j = 1 To cSopr.Npl
      MsgBox "Введите сопроводительные данные по " & j & " плавке", 48, "СООБЩЕНИЕ "
      frmDonixEgy.Show vbModal
      cPl.KolTel = cSopr.Pl(j).KolTel
      cPl.N_osi = cSopr.Pl(j).N_osi
      cSopr.Pl(j) = cPl
      txt((j - 1) * 6 + 0).Text = cSopr.Pl(j).NST
      txt((j - 1) * 6 + 1).Text = cSopr.Pl(j).Npl
      txt((j - 1) * 6 + 2).Text = cSopr.Pl(j).MST
      txt((j - 1) * 6 + 3).Text = cSopr.Pl(j).TSLT
      txt((j - 1) * 6 + 4).Text = cSopr.Pl(j).KSLT
    Next j
  Else
    For j = 1 To cSopr.Npl
      txt((j - 1) * 6 + 1).Text = cSopr.Pl(j).Npl
    Next j
    MsgBox "БАЗА НЕДОСТУПНА ", 48, "СОБЩЕНИЕ  "
    MsgBox "ВВЕДИТЕ САМОСТОЯТЕЛЬНО" & Chr(13) & "сопроводительные данные по плавкам", 48, "НАПОМИНАНИЕ  "
  End If
  
  Mnu_Open.Enabled = True

  Exit Sub
Cansel:
  If Err.Number = 0 Then Exit Sub
  MsgBox Err.Description & Chr(13) & "11.Пригласите наладчиков", 16, "ОШИБКА  " & Err.Number
End Sub

Private Sub Mnu_Print_Click()
  CmdCancel.Visible = False
  Me.PrintForm
  CmdCancel.Visible = True
End Sub

Private Sub Mnu_Trans_Click()
Dim i%
Dim s$
On Error GoTo Mnu_TransErr

  txtCover2 = ""

  For i = 1 To cSost.Sopr.Npl
    If Len(txt((i - 1) * 6 + 5)) = 0 Then
       MsgBox "Введите вес плавки", 48, "СООБЩЕНИЕ "
       Exit Sub
    End If
    If txt((i - 1) * 6 + 1) <> "" And txt((i - 1) * 6 + 1) <> "0000000" Then
      txtCover2 = txtCover2 & txt((i - 1) * 6 + 1) & " " & _
        Format(cSost.Ves_in(cSost.Sopr.Pl(i).N_osi).DATA, "dd/mm/yyyy") & " " & _
        Format(cSost.Ves_in(cSost.Sopr.Pl(i).N_osi).DATA, "hh:mm") & " " & _
        Format(cSost.Sopr.Pl(i).Ves, "000.0") & vbCrLf
    End If
  Next i
  
  txtCover1.Visible = True
  txtCover2.Visible = True
  
  DoEvents
  
  Open PathStprokat & "\" & Format(Now, "ddmmhhmm") & ".txt" For Output As #1
    Print #1, txtCover2
  Close #1
  
  Open App.path & "\ASUTP\" & Format(Now, "ddmmhhmm") & ".txt" For Output As #1
    Print #1, txtCover2
  Close #1
  
  Mnu_Trans.Enabled = False
  Mnu_Open.Enabled = False
  
Exit Sub
Mnu_TransErr:
  If Err.Number = 0 Then Exit Sub
  If Err.Number = 75 Or Err.Number = 52 Then
    MsgBox Err.Description & Chr(13) & " БАЗА СТАЛЬ-ПРОКАТ НЕДОСТУПНА", 16, "ОШИБКА  " & Err.Number
  Else
    MsgBox Err.Description & Chr(13) & "12.Пригласите наладчиков", 16, "ОШИБКА  " & Err.Number
  End If
End Sub

Private Sub cmdCancel_Click()
  Unload frmDonixEgy
  Unload frmPrintItog
End Sub

Private Sub txt_DblClick(Index As Integer)
Dim j%
  j = 1 + Index \ 6
  cPl.KolTel = cSost.Sopr.Pl(j).KolTel
  cPl.N_osi = cSost.Sopr.Pl(j).N_osi
  cSost.Sopr.Pl(j) = cPl
  txt((j - 1) * 6 + 0).Text = cSost.Sopr.Pl(j).NST
  txt((j - 1) * 6 + 1).Text = cSost.Sopr.Pl(j).Npl
  txt((j - 1) * 6 + 2).Text = cSost.Sopr.Pl(j).MST
  txt((j - 1) * 6 + 3).Text = cSost.Sopr.Pl(j).TSLT
  txt((j - 1) * 6 + 4).Text = cSost.Sopr.Pl(j).KSLT
End Sub

Админ: Еще раз предупреждаю - пользуемся разметкой, иначе последуют санкции!