?? frmxb.frm

?? 一個用vb 和sql編的數據庫,比較簡單,初學者可以參考一下,借鑒一下
?? FRM
?? 第 1 頁 / 共 4 頁
字號:
上一頁 1 2 34
Dim auto As Integer, autm As Integer
Dim ye1 As Integer, ye2 As Integer, mo1 As Byte, mo2 As Byte, da1 As Byte, da2 As Byte
Dim audate As Date

'啟動預定系統
Set zbauto = OpenDatabase(App.Path + "\zb.mdb")
Set reauto = zbauto.OpenRecordset("autoadd", dbOpenDynaset)
'Set zbauto = OpenDatabase(App.Path + "\zb.mdb")
Set rexb = zbauto.OpenRecordset("xb", dbOpenDynaset)
If reauto.RecordCount <> 0 Then '若有預定
   reauto.MoveFirst
   Do While reauto.AbsolutePosition <> -1
   '尋找XB中最后一條符合某條預定條件的記錄
        rexb.FindLast ("autoadd='" + reauto.Fields(3) + "'" + _
        " and  收支金額=" + Str(reauto.Fields(1)) + _
        " and  類別='" + reauto.Fields(2) + "'")
          If Not (rexb.NoMatch) Then '若XB中有這樣一條由預定產生的記錄
             audate = rexb.Fields(0)
             auto = Date - rexb.Fields(0) '今天距那天有多少天間隔
             ye1 = Val(Mid(Format(Date, "yyyy-mm-dd"), 1, 4)): ye2 = Val(Mid(Format(rexb.Fields(0), "yyyy-mm-dd"), 1, 4))
             mo1 = Month(Date): mo2 = Month(rexb.Fields(0))
             da1 = Val(Mid(Format(Date, "yy-mm-dd"), 7, 2))
             da2 = Val(Mid(Format(rexb.Fields(0), "yy-mm-dd"), 7, 2))
             autm = (ye1 - ye2) * 12 + (mo1 - mo2)
             If da1 < da2 Then
                autm = autm - 1
             End If
             
          Select Case rexb.Fields(5)
               Case "每天"
               For i = 1 To auto
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("D", i, audate) 'Date - (i - 1) * 1
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每周"
                For i = 1 To Int(auto / 7)
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("ww", i, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每月"
                For i = 1 To autm
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("m", i, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每季"
                For i = 1 To Int(autm / 3)
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("m", i * 3, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每年"
                For i = 1 To Int(autm / 12)
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("yyyy", i, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
         End Select
          Else '若XB中沒有這樣一條由預定產生的記錄,也就是有條預定還沒有起作用
             audate = reauto.Fields(0)
             auto = Date - reauto.Fields(0)  '今天距那天有多少天間隔
             ye1 = Val(Mid(Format(Date, "yyyy-mm-dd"), 1, 4)): ye2 = Val(Mid(Format(reauto.Fields(0), "yyyy-mm-dd"), 1, 4))
             mo1 = Month(Date): mo2 = Month(reauto.Fields(0))
             da1 = Val(Mid(Format(Date, "yy-mm-dd"), 7, 2))
             da2 = Val(Mid(Format(reauto.Fields(0), "yy-mm-dd"), 7, 2))
             autm = (ye1 - ye2) * 12 + mo1 - mo2
             If da1 < da2 Then
                autm = autm - 1
             End If
              If auto > 0 Then '已過了預定的日期
               rexb.AddNew     '則增加一個預定記錄
                   rexb.Fields(0) = reauto.Fields(0)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
              End If
             Select Case reauto.Fields(3)
               Case "每天"
               For i = 1 To auto
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("d", i, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每周"
                For i = 1 To Int(auto / 7)
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("ww", i, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每月"
                For i = 1 To autm
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("m", i, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每季"
                For i = 1 To Int(autm / 3)
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("m", i * 3, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
               Case "每年"
                For i = 1 To Int(autm / 12)
                   rexb.AddNew
                   rexb.Fields(0) = DateAdd("yyyy", i, audate)
                   rexb.Fields(1) = reauto.Fields(1)
                   rexb.Fields(2) = reauto.Fields(2)
                   rexb.Fields(5) = reauto.Fields(3)
                   rexb.Fields(3) = reauto.Fields(4)
                   If Mid(rexb.Fields(2), 4, 1) = "入" Then
                        rexb.Fields(4) = True
                   Else
                         rexb.Fields(4) = False
                   End If
                   rexb.Update
               Next i
         End Select
    End If
    reauto.MoveNext
    Loop
End If

Dim reyear As Recordset
Set reyear = zbauto.OpenRecordset("year")

If rexb.RecordCount = 0 Then '沒有任何記錄，則是第一次使用
Set reauto = zbauto.OpenRecordset("yzj", dbOpenDynaset)
    frmfirst.Show 1
                         If frmfirst.firdate = "" Then
                        MsgBox "您什么都沒有輸入,下次在用吧。B-b!", 48, "再見"
                         Call Form_Unload(0)
                         End
                        End If
 
                         If reyear.RecordCount = 0 Then
                        reyear.AddNew
                        reyear.Fields(0) = Mid(Format(CDate(frmfirst.firdate), "yyyy-mm-dd"), 1, 4) '保證在YEAR表中有一個年度
                        reyear.Update
                        
                          End If
rexb.AddNew
   rexb.Fields(0) = CDate(frmfirst.firdate)
   rexb.Fields(1) = 0
   rexb.Fields(2) = "其它收入"
   rexb.Fields(3) = "這是程序自己加的記錄,你可以修改它."
   rexb.Fields(4) = True
   rexb.Update
   myyear = Mid(Format(CDate(frmfirst.firdate), "yyyy-mm-dd"), 1, 4)
rexb.Close

    Dim reyzj As Recordset
    Set reyzj = zbauto.OpenRecordset("yzj")
    reyzj.AddNew
    reyzj.Fields(0) = CDate(frmfirst.firdate)
    reyzj.Fields(1) = frmfirst.firmoney
    reyzj.Update
    reyzj.Close
   reauto.Close
End If

   reyear.MoveLast
myyear = reyear.Fields(0)
Me.Caption = "小小收支薄-每日收支詳情登記" + "(" + myyear + "年度)"
Data1.DatabaseName = App.Path + "\zb.mdb"
Data1.RecordSource = "select * from xb where year(收支日期)='" + myyear + "' order by 收支日期"
Data1.Refresh
Data2.DatabaseName = App.Path + "\zb.mdb"
Data2.RecordSource = "select * from yzj where year(年月)='" + myyear + "' order by 年月"
Data2.Refresh


Dim n As Integer

Data1.Recordset.MoveFirst
Do

Data1.Recordset.MoveNext
Loop Until Data1.Recordset.AbsolutePosition = -1 'Data1.Recordset.RecordCount - 1   '是否到最后一個記錄(不是檢測記錄末)
If Data1.Recordset.RecordCount = 1 Then Toolbar1.Buttons.Item(4).Enabled = False '若此句放在前面recordcount為1,經movefirst記錄移動后,得到recordcount正確值.
Data1.Recordset.MoveFirst
'設置標尺屬性
If Data1.Recordset.RecordCount > 1 Then
Slirecon.max = Data1.Recordset.RecordCount - 1
Slirecon.LargeChange = Int(Slirecon.max / 10) + 1
Else
Slirecon.max = Data1.Recordset.RecordCount
Slirecon.LargeChange = 0
End If
Label9.Caption = Str(Data1.Recordset.RecordCount)
Label10.Caption = Str(Data1.Recordset.AbsolutePosition + 1)
Dim t As Boolean
t = True
visok (t)
mok
End Sub



Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer, j As Integer
j = Forms.Count - 1
For i = 0 To j
Unload Forms(0)
Next i
End Sub

Private Sub HELP_Click()

'MYHELP
End Sub


Private Sub JS_Click()
dctable ("yzj")
End Sub

Private Sub PX_Click()
Command5_Click
End Sub

Private Sub SC_Click()
Command2_Click
End Sub

Private Sub Slirecon_Change()
'Debug.Print Slirecon.Value
Data1.Recordset.MoveFirst
Data1.Recordset.Move Slirecon.Value
mok
End Sub

Private Sub sy_Click()
Command4_Click
End Sub

Private Sub SZ_Click()
dctable ("xb")
End Sub

Private Sub Text1_LostFocus(Index As Integer)
If Not IsDate(Text1(0).Text) Then
Text1(0).SetFocus
Text1(0).SelStart = 0
Text1(0).SelLength = Len(Text1(0).Text)
End If
If Not IsNumeric(Text1(1).Text) Then
Text1(1).SetFocus
Text1(1).SelStart = 0
Text1(1).SelLength = Len(Text1(0).Text)
End If
End Sub

Private Sub textfind_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call textfind_LostFocus
End If
End Sub

Private Sub textfind_LostFocus()
If Not IsDate(textfind.Text) Then
With textfind
.SelStart = 0
.SelLength = Len(.Text)
.SetFocus
End With
Else
Data1.Recordset.FindFirst "收支日期=CDate('" + textfind.Text + "')"
            If Data1.Recordset.NoMatch Then
MsgBox "沒有找到" + textfind.Text + "的收支情況！" + Chr(13) + Chr(13) + "將查找最接近的一個收支個記錄。", 48, "查找"

Data1.Recordset.FindLast "收支日期<=CDate('" + textfind.Text + "')"
            End If
End If
 Call mok
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
       Case Is = "add"
       Command1_Click
       Case Is = "pre"
        Command4_Click
       Case Is = "next"
        Command3_Click
       Case Is = "edit"
       comedit_Click
       Case Is = "ok"
       Comok_Click
       Case Is = "cancel"
       Comcancl_Click
       Case Is = "del"
       Command2_Click
       Case Is = "js"
       Comzt_Click
       Case Is = "index"
       Command5_Click
       Case Is = "find"
       comlr_Click
       Case Is = "ctrl"
       Comauto_Click
       Case Is = "table"
       comtable_Click
       Case Is = "help"
       MYHELP
       'MsgBox "幫助尚未建立！", 48, "sorry"
       Case Is = "about"
       Frmabout.Show 1
       Case Is = "exit"
      Unload frmxb
End Select
End Sub

Private Sub WRITER_Click()
 Frmabout.Show 1
End Sub

Private Sub xg_Click()
comedit_Click
End Sub

Private Sub XY_Click()
Command3_Click
End Sub

Private Sub xz_Click()
frmyear.Show 1
End Sub

Private Sub YD_Click()
Comauto_Click
End Sub

Private Sub YJS_Click()
Comzt_Click
End Sub

Private Sub zj_Click()
Command1_Click
End Sub
上一頁 1 2 34
?? 文件大小 69 K
?? 上傳用戶 zhuxiaobei123
?? 所屬分類其他
??? 相關標簽

#sql #數據庫 #初學者 #比較
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmxb.frm

?? 快捷鍵說明
