frmsetplan.frm

用户MODBUS规约通信编程,起参考作用.

Dim txtsql As String
Dim conn1 As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i As Integer
Dim txt As String
Dim Mid_time As String
Dim tim_in_1, tim_in_2 As String
Dim length_1, length_2 As Integer
Dim tim_flag_1, tim_flag_2 As String





i = 0

connecting = "provider=Microsoft.Jet.oledb.4.0;" & _
            "data source=" & App.Path & "\jk.mdb"
                   
conn1.Open connecting
txtsql = "select * from 计划设置表"
rs.CursorLocation = adUseClient
rs.Open txtsql, conn1, adOpenKeyset, adLockPessimistic

If Len(Text1.Text) = 0 Or Len(Text2.Text) = 0 Or Len(Text3.Text) = 0 Or Len(Text4.Text) = 0 Then
MsgBox "不能空"
Exit Sub
End If
If Len(Text1.Text) = 1 Then
Text1.Text = "0" & Text1.Text
End If
If Len(Text2.Text) = 1 Then
Text2.Text = "0" & Text2.Text
End If
If Len(Text3.Text) = 1 Then
Text3.Text = "0" & Text3.Text
End If
If Len(Text4.Text) = 1 Then
Text4.Text = "0" & Text4.Text
End If

begin_time = Text1.Text & ":" & Text2.Text
end_time = Text3.Text & ":" & Text3.Text





If CDate(begin_time) <= CDate(end_time) Then

 totaltime = DateDiff("n", CDate(begin_time), CDate(end_time))
 
 If Option1.Value = True Then
 
JG = CInt(Text7.Text)
total_Re = totaltime \ JG
For i = 0 To total_Re
txt = CStr(DateAdd("n", JG * i, CDate(begin_time)))
  
  If (Mid(txt, 2, 1) = ":") Then
    txt = "0" & txt
End If

txt = Mid(txt, 1, 5)

With rs
.AddNew
.Fields(0) = Combo1.Text
.Fields(1) = Combo2.Text
.Fields(2) = Combo3.Text
.Fields(3) = txt
.Fields(4) = Text5.Text
End With
Next
rs.Update
rs.Requery
rs.Close
frmplan.Show
         
Unload Me
Exit Sub
End If




If Option2.Value = True Then
 total_Re = CInt(Text8.Text)
JG = totaltime / (total_Re)


  For i = 0 To total_Re - 1
  txt = CStr(DateAdd("n", JG * i, CDate(begin_time)))
  
  If (Mid(txt, 2, 1) = ":") Then
    txt = "0" & txt
   End If
  txt = Mid(txt, 1, 5)

             If i = total_Re - 1 Then
                With rs
                    .AddNew
                    .Fields(0) = Combo1.Text
                    .Fields(1) = Combo2.Text
                    .Fields(2) = Combo3.Text
                    .Fields(3) = txt
                    .Fields(4) = Text5.Text
                    
               End With
             Else
                With rs
                   .AddNew
                    .Fields(0) = Combo1.Text
                    .Fields(1) = Combo2.Text
                    .Fields(2) = Combo3.Text
                    .Fields(3) = txt
                    .Fields(4) = Text5.Text
                End With
             End If
         Next i
         rs.Update
         rs.Requery
         rs.Close
         frmplan.Show
          Unload Me
         End If
         
 Else

 If Option1.Value = True Then
  Mid_time = end_time
  end_time = "23:59"
  totaltime = DateDiff("n", CDate(begin_time), CDate(end_time))
 
 
JG = CInt(Text7.Text)
total_Re = totaltime / JG
For i = 0 To total_Re - 1
txt = CStr(DateAdd("n", JG * i, CDate(begin_time)))
  
  If (Mid(txt, 2, 1) = ":") Then
    txt = "0" & txt
 Else
    
   If (Mid(txt, 3, 1) <> ":") Then
   txt = "23:59"
   End If
   
    
    End If

txt = Mid(txt, 1, 5)

With rs
.AddNew
.Fields(0) = Combo1.Text
.Fields(1) = Combo2.Text
.Fields(2) = Combo3.Text
.Fields(3) = txt
.Fields(4) = Text5.Text
End With
Next


end_time = Mid_time
begin_time = "00:00"
  totaltime = DateDiff("n", CDate(begin_time), CDate(end_time))
 
 JG = CInt(Text7.Text)
total_Re = totaltime \ JG
For i = 0 To total_Re - 1
txt = CStr(DateAdd("n", JG * i, CDate(begin_time)))
  
  If (Mid(txt, 2, 1) = ":") Then
    txt = "0" & txt
End If
txt = Mid(txt, 1, 5)
With rs
.AddNew
.Fields(0) = Combo1.Text
.Fields(1) = Combo2.Text
.Fields(2) = Combo3.Text
.Fields(3) = txt
.Fields(4) = Text5.Text
End With
Next
rs.Update
rs.Requery
rs.Close
frmplan.Show
Unload Me
Exit Sub
End If



If Option2.Value = True Then
Dim Total_time, total As Long
Dim mid_Re As Integer
 Mid_time = end_time
  end_time = "23:59"
  
 
totaltime = DateDiff("n", CDate(begin_time), CDate("23:59"))
total = DateDiff("n", CDate("00:00"), CDate(Mid_time))

Total_time = totaltime + total '时间间隔
 total_Re = CInt(Text8.Text)
 mid_Re = total_Re
 JG = Total_time / (total_Re)
 total_Re = totaltime / JG

For i = 0 To total_Re - 2
  txt = CStr(DateAdd("n", JG * i, CDate(begin_time)))
  
  If (Mid(txt, 2, 1) = ":") Then
    txt = "0" & txt
   End If
  txt = Mid(txt, 1, 5)

             If i = total_Re - 1 Then
                With rs
                    .AddNew
                    .Fields(0) = Combo1.Text
                    .Fields(1) = Combo2.Text
                    .Fields(2) = Combo3.Text
                    .Fields(3) = txt
                    .Fields(4) = Text5.Text
                    
               End With
             Else
                With rs
                   .AddNew
                    .Fields(0) = Combo1.Text
                    .Fields(1) = Combo2.Text
                    .Fields(2) = Combo3.Text
                    .Fields(3) = txt
                    .Fields(4) = Text5.Text
                End With
             End If
         Next i
         
 end_time = Mid_time
begin_time = "00:00"
total_Re = mid_Re - total_Re

         
For i = 0 To total_Re - 2
  txt = CStr(DateAdd("n", JG * i, CDate(begin_time)))
  
  If (Mid(txt, 2, 1) = ":") Then
    txt = "0" & txt
   End If
  txt = Mid(txt, 1, 5)

             If i = total_Re - 1 Then
                With rs
                    .AddNew
                    .Fields(0) = Combo1.Text
                    .Fields(1) = Combo2.Text
                    .Fields(2) = Combo3.Text
                    .Fields(3) = txt
                    .Fields(4) = Text5.Text
                    
               End With
             Else
                With rs
                   .AddNew
                    .Fields(0) = Combo1.Text
                    .Fields(1) = Combo2.Text
                    .Fields(2) = Combo3.Text
                    .Fields(3) = txt
                    .Fields(4) = Text5.Text
                End With
             End If
         Next i
         
         
         
         rs.Update
         rs.Requery
         rs.Close
         frmplan.Show
          Unload Me
         End If
         
 
 
 
 
 
 
 
 End If
 
         
         
        
        
         
         


         
End Sub

Private Sub asPopup2_Click(Cancel As Boolean)
Unload Me

End Sub

Private Sub Form_Load()


On Error Resume Next


XPForm1.Make
Dim txtsql As String
Dim conn2 As New ADODB.Connection
Dim mrc1, mrc2 As New ADODB.Recordset
Dim connecting As String
connecting = "provider=Microsoft.Jet.oledb.4.0;" & _
            "data source=" & App.Path & "\jk.mdb"


conn2.Open connecting
'Me.WindowState = 2
txtsql = "select * from 地点设置表"
Set mrc1 = conn2.Execute(txtsql)
If mrc1.EOF = True And mrc1.BOF = True Then
Else
mrc1.MoveFirst
Do While mrc1.EOF <> True
Combo3.AddItem mrc1.Fields(1)
mrc1.MoveNext
Loop
End If
mrc1.Close

txtsql = "select * from 人员设置表"
Set mrc1 = conn2.Execute(txtsql)
If mrc1.EOF = True And mrc1.BOF = True Then
Else
mrc1.MoveFirst
Do While mrc1.EOF <> True
Combo2.AddItem mrc1.Fields(1)
mrc1.MoveNext

Loop
End If
mrc1.Close
txtsql = "select * from 棒号设置表"
Set mrc1 = conn2.Execute(txtsql)
If mrc1.EOF = True And mrc1.BOF = True Then
Else
mrc1.MoveFirst
Do While mrc1.EOF <> True
Combo1.AddItem mrc1.Fields(1)
mrc1.MoveNext
Loop
End If
mrc1.Close

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set conn1 = Nothing

TimeDelay 500

End Sub