进销存管理系统

Private Sub DoGroupCube(SlCol As String, JeCol As String) Dim arrSlCol() As String Dim arrJeCol() As String Dim k As Integer Dim total As Double

Call ON_GetArray(SlCol, arrSlCol) Call ON_GetArray(JeCol, arrJeCol) LstView.ListItems.Add , , \

LstView.ListItems(LstView.ListItems.Count).SubItems(1) = \总计\For k = 0 To UBound(arrSlCol) total = 0

For J = 1 To LstView.ListItems.Count

total = total + Val(LstView.ListItems(J).SubItems(Val(arrSlCol(k)))) Next

LstView.ListItems(LstView.ListItems.Count).SubItems(Val(arrSlCol(k))) = total Next

For k = 0 To UBound(arrJeCol) total = 0

For J = 1 To LstView.ListItems.Count

total = total + Val(LstView.ListItems(J).SubItems(Val(arrJeCol(k)))) Next

LstView.ListItems(LstView.ListItems.Count).SubItems(Val(arrJeCol(k))) = Format(total, \Next End Sub

Private Sub Form_Load() Dim fl_Num As Single Dim fl_Cash As Double

Me.Icon = LoadResPicture(101, vbResIcon)

Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 4 Me.Caption = \查看[\的明细情况\Call DoStyle

If GetInitData(fl_Num, fl_Cash) = True Then Call DoShow(fl_Num, fl_Cash) ' Call DoRemain(fl_Num, fl_Cash) End If End Sub

Private Sub DoShow(m_drNum As Single, m_drCash As Double) Dim dsRec As ADODB.Recordset Dim dsSQL As String Dim I As Integer

24

Dim itmX

Dim rd_theSL As Single Dim rd_theJE As Double

Dim rd_RKJE As Double, rd_CKJE As Double rd_theSL = m_drNum rd_theJE = m_drCash

dsSQL = \

Set dsRec = AppCN.Execute(dsSQL & \AND Month(KDRQ)=\& m_Month & \AND Year(KDRQ)=\If dsRec.EOF Then

' MsgBox \无效的材料编号！\ Exit Sub End If I = 1

Set itmX = LstView.ListItems.Add(, , A & I)

itmX.SubItems(1) = dsRec.Fields(\ itmX.SubItems(3) = \期初数量\ itmX.SubItems(10) = rd_theSL

itmX.SubItems(11) = Format(m_drCash, \Do While Not dsRec.EOF I = I + 1

Set itmX = LstView.ListItems.Add(, , A & I) rd_RKJE = IIf(dsRec.Fields(\= \0, dsRec.Fields(\ rd_CKJE = IIf(dsRec.Fields(\= \0, dsRec.Fields(\

rd_theSL = rd_theSL + Val(dsRec.Fields(\ m_drCash = m_drCash + rd_RKJE - rd_CKJE itmX.SubItems(1) = dsRec.Fields(\ itmX.SubItems(2) = dsRec.Fields(\ itmX.SubItems(3) = dsRec.Fields(\ itmX.SubItems(4) = dsRec.Fields(\ itmX.SubItems(5) = IIf(dsRec.Fields(\= \\Format(dsRec.Fields(\ itmX.SubItems(6) = IIf(dsRec.Fields(\= \\Format(dsRec.Fields(\ itmX.SubItems(7) = dsRec.Fields(\ itmX.SubItems(8) = IIf(dsRec.Fields(\= \\Format(dsRec.Fields(\ itmX.SubItems(9) = IIf(dsRec.Fields(\= \\Format(dsRec.Fields(\

25

itmX.SubItems(10) = rd_theSL

itmX.SubItems(11) = Format(m_drCash, \ dsRec.MoveNext Loop End Sub

Private Sub DoStyle() Dim intWid As Integer intWid = 1200

LstView.ColumnHeaders.Add , , \序号\

LstView.ColumnHeaders.Add , , \日期\

LstView.ColumnHeaders.Add , , \凭证编号\LstView.ColumnHeaders.Add , , \摘要\

LstView.ColumnHeaders.Add , , \收入数量\LstView.ColumnHeaders.Add , , \收入单价\LstView.ColumnHeaders.Add , , \收入金额\LstView.ColumnHeaders.Add , , \发出数量\LstView.ColumnHeaders.Add , , \发出单价\LstView.ColumnHeaders.Add , , \发出金额\LstView.ColumnHeaders.Add , , \结存数量\LstView.ColumnHeaders.Add , , \结存金额\End Sub

Private Sub Form_Resize() On Error Resume Next

LstView.Move 0, 100 + 500 + 50, Me.ScaleWidth, Me.ScaleHeight - Me.StatusBar1.Height - 650

End Sub

Private Function GetInitData(m_giNum As Single, m_giCash As Double) As Boolean Dim drRec_1 As ADODB.Recordset Dim drRec_2 As ADODB.Recordset Dim drSQL As String

GetInitData = True

m_giNum = -2002.1994 m_giCash = -2002.1994

drSQL = \

drSQL = drSQL & \m_Year

Set drRec_1 = AppCN.Execute(drSQL)

26

If drRec_1.EOF Then

drSQL = \

drSQL = drSQL & \& m_Year

Set drRec_2 = AppCN.Execute(drSQL) If drRec_2.EOF Then

MsgBox \没有盘点，没有期初期末数据！\ GetInitData = False Else

m_giNum = drRec_2.Fields(\ m_giCash = drRec_2.Fields(\ End If

drRec_2.Close: Set drRec_2 = Nothing Else

m_giNum = drRec_1.Fields(\ m_giCash = drRec_1.Fields(\End If

drRec_1.Close: Set drRec_1 = Nothing End Function

Private Sub Form_Unload(Cancel As Integer) m_CLBH = \m_Month = 0 m_Year = 0 End Sub

Private Sub DoRemain(m_drNum As Single, m_drCash As Double) Dim rd_theSL As Single Dim rd_theJE As Double

Dim rd_RKJE As Double, rd_CKJE As Double rd_theSL = m_drNum rd_theJE = m_drCash

For I = 1 To Me.LstView.ListItems.Count rd_theSL = rd_theSL + Val(LstView.ListItems(I).SubItems(4)) Val(LstView.ListItems(I).SubItems(7))

LstView.ListItems(I).SubItems(10) = rd_theSL If rd_theSL <> 0 Then

rd_CKJE = Val(Format(LstView.ListItems(I).SubItems(9), \ rd_theJE = rd_theJE + rd_RKJE - rd_CKJE Else

rd_theJE = 0 End If

LstView.ListItems(I).SubItems(11) = Format(rd_theJE, \

- 27