⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmkhtj.frm

📁 一个关于进销存的源代码
💻 FRM
字号:
VERSION 5.00
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "Msdatgrd.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomct2.ocx"
Begin VB.Form frmKhTj 
   Caption         =   "顾客消费额统计"
   ClientHeight    =   5040
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5955
   LinkTopic       =   "Form1"
   ScaleHeight     =   5040
   ScaleWidth      =   5955
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text1 
      BackColor       =   &H00C0FFFF&
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   4560
      Width           =   5655
   End
   Begin VB.Frame Frame2 
      Caption         =   "客户消费统计"
      Height          =   3495
      Left            =   120
      TabIndex        =   7
      Top             =   960
      Width           =   5655
      Begin MSDataGridLib.DataGrid DataGrid1 
         Height          =   3135
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Width           =   5400
         _ExtentX        =   9525
         _ExtentY        =   5530
         _Version        =   393216
         HeadLines       =   1
         RowHeight       =   15
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "--选择起止期限再点击确定--"
      Height          =   735
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5655
      Begin VB.CommandButton Command2 
         Caption         =   "退出"
         Height          =   255
         Left            =   4920
         TabIndex        =   4
         Top             =   280
         Width           =   615
      End
      Begin VB.CommandButton Command1 
         Caption         =   "确定"
         Height          =   255
         Left            =   4200
         TabIndex        =   3
         Top             =   280
         Width           =   615
      End
      Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2 
         Height          =   255
         Left            =   2160
         OleObjectBlob   =   "frmKhTj.frx":0000
         TabIndex        =   5
         Top             =   285
         Width           =   255
      End
      Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1 
         Height          =   255
         Left            =   240
         OleObjectBlob   =   "frmKhTj.frx":0062
         TabIndex        =   6
         Top             =   285
         Width           =   255
      End
      Begin MSComCtl2.DTPicker DTPicker2 
         Height          =   255
         Left            =   2400
         TabIndex        =   2
         Top             =   285
         Width           =   1575
         _ExtentX        =   2778
         _ExtentY        =   450
         _Version        =   393216
         Format          =   25362433
         CurrentDate     =   38987
      End
      Begin MSComCtl2.DTPicker DTPicker1 
         Height          =   255
         Left            =   480
         TabIndex        =   1
         Top             =   285
         Width           =   1575
         _ExtentX        =   2778
         _ExtentY        =   450
         _Version        =   393216
         Format          =   25362433
         CurrentDate     =   38987
      End
   End
End
Attribute VB_Name = "frmKhTj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public olddate As Date
Public newdate As Date
Public tjcash As Double
Private Sub Command1_Click()
    If DTPicker1.Value > DTPicker2.Value Then
            MsgBox "开始日期错误"
    Else
             olddate = DTPicker1.Value
             newdate = DTPicker2.Value
             
             Frame2.Caption = DTPicker1.Value & "至" & DTPicker2.Value & "各顾客消费总额"
             '按照物品库存表查询
             Dim rdst As New ADODB.Recordset        '按商品列表进行
             Dim rdst2 As New ADODB.Recordset
             Dim rdst3 As New ADODB.Recordset
             Dim rdst4 As New ADODB.Recordset
             '先把消费额定为0
             rdst4.Open "update khtj set 消费额='0'", g_conn
             Set rdst4 = Nothing
                 
                 rdst.Open "select * from Customers", g_conn
                   Do While Not rdst.EOF
                        rdst3.Open "select * from khtj where 客户卡号= '" & rdst!客户卡号 & "'", g_conn
                             If rdst3.EOF = True Then
                                   rdst4.Open "insert into khtj values('" & rdst!客户卡号 & "','" & rdst!客户名称 & "','" & KHXF(rdst!客户卡号) & "')", g_conn
                                   Set rdst4 = Nothing
                             Else
                                   rdst4.Open "update khtj set 消费额 ='" & KHXF(rdst!客户卡号) & "' where 客户卡号='" & rdst!客户卡号 & "'", g_conn
                                   Set rdst4 = Nothing
                             End If
                        Set rdst3 = Nothing
                   rdst.MoveNext
                   Loop
             '单商品查询后算出数量插到表中
             '显示表
      End If
          
      rdst4.Open "update khtj set 消费额 ='0' where 消费额='0'", g_conn
      Set rdst4 = Nothing
                
    tjcash = 0
    
    If olddate = "0:00:00" Then
        DTPicker2.Value = Date
        DTPicker1.Value = Date - 7
    Else
        DTPicker2.Value = newdate
        DTPicker1.Value = olddate
    End If
    
    Frame2.Caption = DTPicker1.Value & "至" & DTPicker2.Value & "各客户消费总额"
    Set rdst = Nothing
        rdst.CursorLocation = adUseClient
    rdst.Open "select * from KhTj where 消费额 <> '0'", g_conn
    'Adodc1.RecordSource = "select * from KhTj"
    Set DataGrid1.DataSource = rdst
        DataGrid1.ReBind
        DataGrid1.Refresh
    DataGrid1.Width = 5400

    DataGrid1.Columns.Item(0).Width = 1550
    DataGrid1.Columns.Item(1).Width = 1750
    DataGrid1.Columns.Item(2).Width = 1550
        Set rdst = Nothing
        rdst.Open "select * from khtj", g_conn
            Do While Not rdst.EOF
                tjcash = tjcash + Val(rdst!消费额)
                rdst.MoveNext
            Loop
    Text1.Text = DTPicker1.Value & "至" & DTPicker2.Value & "所有客户消费总额为" & tjcash & "元."
    
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Function KHXF(dm As String) As Integer
     Dim i As Integer
         i = 0
     Dim rdst As New ADODB.Recordset
     rdst.Open "select * from SellsCustomers where 客户卡号='" & dm & " '", g_conn
     Do While Not rdst.EOF
         If CDate(rdst!消费日期) <= DTPicker2.Value And CDate(rdst!消费日期) >= DTPicker1.Value Then
             i = i + Val(rdst!消费金额)
         End If
         rdst.MoveNext
     Loop
         KHXF = i
End Function

Private Sub Form_Load()
    tjcash = 0
    
    If olddate = "0:00:00" Then
        DTPicker2.Value = Date
        DTPicker1.Value = Date - 7
    Else
        DTPicker2.Value = newdate
        DTPicker1.Value = olddate
    End If
    
    Frame2.Caption = DTPicker1.Value & "至" & DTPicker2.Value & "各客户消费总额"
    Dim rdst As New ADODB.Recordset
    rdst.CursorLocation = adUseClient
    rdst.Open "select * from KhTj where 消费额 <> '0'", g_conn
    'Adodc1.RecordSource = "select * from KhTj"
    Set DataGrid1.DataSource = rdst
    DataGrid1.ReBind
    DataGrid1.Refresh
    DataGrid1.Width = 5400

    DataGrid1.Columns.Item(0).Width = 1550
    DataGrid1.Columns.Item(1).Width = 1750
    DataGrid1.Columns.Item(2).Width = 1550
    
    Set rdst = Nothing
    
        rdst.Open "select * from khtj", g_conn
            Do While Not rdst.EOF
                tjcash = tjcash + Val(rdst!消费额)
                rdst.MoveNext
            Loop
    Text1.Text = DTPicker1.Value & "至" & DTPicker2.Value & "所有客户消费总额为" & tjcash & "元."
    
    Call Command1_Click
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -