xsmx.frm

一套商品管理

VERSION 5.00
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Object = "{4F29B06F-16D9-4A0C-9C8A-2F0C02F625FE}#1.7#0"; "FlexCell.ocx"
Begin VB.Form xsmx 
   Caption         =   "客户销售详细记录"
   ClientHeight    =   5370
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7695
   Icon            =   "xsmx.frx":0000
   LinkTopic       =   "Form3"
   ScaleHeight     =   5370
   ScaleWidth      =   7695
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin FlexCell.Grid Grid1 
      Height          =   4095
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   5655
      _ExtentX        =   9975
      _ExtentY        =   7223
      Cols            =   5
      DisplayRowIndex =   -1  'True
      ExtendLastCol   =   -1  'True
      Rows            =   1
   End
   Begin ACTIVESKINLibCtl.Skin Skn1 
      Left            =   0
      OleObjectBlob   =   "xsmx.frx":000C
      Top             =   0
   End
End
Attribute VB_Name = "xsmx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2008/05/10
'描    述：商品综合管理系统 Sql2000版
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private Sub Form_Load()
Skn1.LoadSkin App.Path & sknPname
Skn1.ApplySkinByName hWnd, "窗体"
Skn1.ApplySkin hWnd
With Grid1
 .OpenFile ("xxmx.cel")
End With
bj_show
End Sub
Private Sub bj_show()
On Error GoTo finish:
If yxsql = "" Then
 Exit Sub
End If
Set Qy1 = cnn.Execute(yxsql)
With Grid1
 .AutoRedraw = False
 .Rows = 1
 Do While Not Qy1.EOF
  .Rows = .Rows + 1
  .Cell(.Rows - 1, 1).Text = Qy1.Fields(0)
  .Cell(.Rows - 1, 2).Text = Qy1.Fields(1)
  .Cell(.Rows - 1, 3).Text = Qy1.Fields(2)
  .Cell(.Rows - 1, 4).Text = Qy1.Fields(3)
  .Cell(.Rows - 1, 5).Text = Qy1.Fields(4)
  .Cell(.Rows - 1, 6).Text = Qy1.Fields(5)
  .Cell(.Rows - 1, 7).Text = Qy1.Fields(6)
  .Cell(.Rows - 1, 8).Text = Qy1.Fields(7)
  .Cell(.Rows - 1, 9).Text = Qy1.Fields(8)
  .Cell(.Rows - 1, 10).Text = Qy1.Fields(9)
  Qy1.MoveNext
 Loop
 Dim RowI As Integer
 Dim IntS As Integer
 RowI = 1
 IntS = 1
 For i = 1 To .Rows - 2
   If .Cell(i, 1).Text = .Cell(i + 1, 1).Text Then
    .Cell(RowI, 11).Text = .Cell(RowI, 11).DoubleValue + .Cell(i, 5).DoubleValue
    .Cell(RowI, 12).Text = .Cell(RowI, 12).DoubleValue + .Cell(i, 8).DoubleValue
   Else
    .Cell(RowI, 11).Text = .Cell(RowI, 11).DoubleValue + .Cell(i, 5).DoubleValue
    .Cell(RowI, 12).Text = .Cell(RowI, 12).DoubleValue + .Cell(i, 8).DoubleValue
    .Range(RowI, 11, i, 11).Merge
    .Range(RowI, 12, i, 12).Merge
    If IntS Mod 2 = 0 Then
    .Range(RowI, 1, i, .Cols - 1).BackColor = RGB(239, 243, 255)
    End If
    RowI = i + 1
    IntS = IntS + 1
   End If
 Next
    .Cell(RowI, 11).Text = .Cell(RowI, 11).DoubleValue + .Cell(i, 5).DoubleValue
    .Cell(RowI, 12).Text = .Cell(RowI, 12).DoubleValue + .Cell(i, 8).DoubleValue
    .Range(RowI, 11, i, 11).Merge
    .Range(RowI, 12, i, 12).Merge
    If IntS Mod 2 = 0 Then
    .Range(RowI, 1, i, .Cols - 1).BackColor = RGB(239, 243, 255)
    Else
    .Range(RowI, 1, i, .Cols - 1).BackColor = RGB(231, 235, 247)
    End If

 .Rows = .Rows + 1
 .Cell(.Rows - 1, 1).Text = "合 计"
 .Cell(.Rows - 1, 4).Text = "(除赠品)合计"
 .Cell(.Rows - 1, 10).Text = "(所有合计)"
 For i = 1 To .Rows - 2
  If .Cell(i, 9).Text <> "赠送" Then
 .Cell(.Rows - 1, 5).Text = .Cell(.Rows - 1, 5).DoubleValue + .Cell(i, 5).DoubleValue
 .Cell(.Rows - 1, 8).Text = .Cell(.Rows - 1, 8).DoubleValue + .Cell(i, 8).DoubleValue
  End If
 .Cell(.Rows - 1, 11).Text = .Cell(.Rows - 1, 11).DoubleValue + .Cell(i, 5).DoubleValue
 .Cell(.Rows - 1, 12).Text = .Cell(.Rows - 1, 12).DoubleValue + .Cell(i, 8).DoubleValue
 Next
 .Range(.Rows - 1, 1, .Rows - 1, .Cols - 1).BackColor = RGB(148, 190, 231)
 .Range(.Rows - 1, 1, .Rows - 1, .Cols - 1).ForeColor = vbBlue
 .ReadOnly = True
 .AutoRedraw = True
 .Refresh
End With
Exit Sub
finish:
Grid1.AutoRedraw = True
Grid1.Refresh
End Sub
Private Sub Form_Resize()
If Me.WindowState <> 1 Then
Grid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set Qy1 = Nothing
yxsql = ""
Grid1.Rows = 1
End Sub