formcode.frm

一套鞋厂的销售管理系统

         ScrollTips      =   0   'False
         MergeCells      =   0
         MergeCompare    =   0
         AutoResize      =   -1  'True
         AutoSizeMode    =   0
         AutoSearch      =   0
         MultiTotals     =   -1  'True
         SubtotalPosition=   1
         OutlineBar      =   0
         OutlineCol      =   0
         Ellipsis        =   0
         ExplorerBar     =   3
         PicturesOver    =   0   'False
         FillStyle       =   0
         RightToLeft     =   0   'False
         PictureType     =   0
         TabBehavior     =   0
         OwnerDraw       =   0
         Editable        =   0   'False
         ShowComboButton =   -1  'True
         WordWrap        =   0   'False
         TextStyle       =   0
         TextStyleFixed  =   0
         OleDragMode     =   0
         OleDropMode     =   0
         DataMode        =   0
         VirtualData     =   0   'False
         DataMember      =   ""
      End
   End
   Begin VB.Label Label1 
      Caption         =   "正在处理中......"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   4920
      TabIndex        =   6
      Top             =   120
      Visible         =   0   'False
      Width           =   2295
   End
End
Attribute VB_Name = "formcode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public cna As New ADODB.Connection
Public cnb As New ADODB.Connection

Private Sub Command1_Click()
    Dim temprecord As New ADODB.Recordset, temprecord1 As New ADODB.Recordset
    Dim dbfcnd As New ADODB.Connection
    Dim strd As String
    Me.MousePointer = 11
    Me.Label1.Visible = True
    DoEvents
    Set temprecord = New Recordset
    strd = "SELECT Order_House.OutHouseCode AS OUTSTOCK_NO, ClientSelladresscode.selladresscode, sum(Order_House_Sub.Number) AS [Number], Order_OutStock.Time AS [Time]  " _
   & " FROM ((Order_House RIGHT JOIN Order_House_Sub ON Order_House.BoxCode = Order_House_Sub.BoxCode) LEFT JOIN Order_OutStock ON Order_House.OutHouseCode = Order_OutStock.OutstockCode) LEFT JOIN ClientSelladresscode ON Order_House.ClientCode = ClientSelladresscode.ClientCode " _
   & " WHERE (((Order_OutStock.Style)=True)) and ClientSelladresscode.selladresscode is not null and left(Order_House.OutHouseCode,1)='O' GROUP BY Order_House.OutHouseCode, ClientSelladresscode.selladresscode, Order_OutStock.Time HAVING (((Order_OutStock.Time)>#10/1/1999#));"
    temprecord.Open strd, GetConnectb(), adLockReadOnly
    If temprecord.RecordCount > 0 Then
       Do Until temprecord.EOF
          Set temprecord1 = New Recordset
          temprecord1.Open "select * from stock_out  where formcode='" & temprecord![OUTSTOCK_NO] & "'", GetConnect(), adOpenKeyset, adLockOptimistic
          If temprecord1.RecordCount = 0 Then
             temprecord1.AddNew
             temprecord1![Formcode] = cField(temprecord![OUTSTOCK_NO])
             temprecord1![ADDRESS] = cField(temprecord![SELLADRESSCODE])
             temprecord1![Date] = Format(temprecord![Time], "yyyy-mm-dd")
             temprecord1![Number] = temprecord![Number]
             temprecord1.Update
          End If
          temprecord.MoveNext
       Loop
    End If
    strd = "SELECT allocate_form.formcode, allocate_form.date AS [time], allocate_form.from, allocate_form.to, Sum(allocate_form_sub.count) AS count " _
          & "  FROM allocate_form LEFT JOIN allocate_form_sub ON allocate_form.formcode = allocate_form_sub.formcode " _
         & "  Where (((allocate_form.Style) = 1)) and allocate_form_sub.count>0 AND trim(allocate_form.from)<>trim(allocate_form.to) and allocate_form.from is not null and allocate_form.to is not null  GROUP BY allocate_form.formcode, allocate_form.date, allocate_form.from, allocate_form.to HAVING (((allocate_form.date)>#10/1/1999#));"

Set temprecord = New Recordset
    temprecord.Open strd, GetConnecta(), adLockReadOnly
    
    If temprecord.RecordCount > 0 Then
       Do Until temprecord.EOF
          Set temprecord1 = New Recordset
          temprecord1.Open "select * from ALLOCATE_FOrMCODE  where formcode='" & temprecord![Formcode] & "'", GetConnect(), adOpenKeyset, adLockOptimistic
          If temprecord1.RecordCount = 0 Then
             temprecord1.AddNew
             temprecord1![Formcode] = cField(temprecord![Formcode])
             temprecord1![ALLOCATEFROM] = Trim(cField(temprecord![From]))
             temprecord1![allocateto] = Trim(cField(temprecord![To]))
             temprecord1![Date] = Format(temprecord![Time], "yyyy-mm-dd")
             temprecord1![Number] = temprecord![Count]
             temprecord1.Update
          End If
          temprecord.MoveNext
       Loop
    End If
    
    Set dbfcnd = GetConnect()
    dbfcnd.ExeCute "formcode"
    Form_Load
        Me.MousePointer = 0
    Me.Label1.Visible = False
End Sub

Private Sub Form_Load()
    Dim temprecord As New ADODB.Recordset
    Set temprecord = New ADODB.Recordset
    temprecord.Open "select stock_out.formcode, Shop_Dossier.name, stock_out.date, stock_out.number from stock_out LEFT OUTER JOIN Shop_Dossier ON stock_out.address = Shop_Dossier.code where backflag=0 ", GetConnect(), adOpenKeyset, adLockOptimistic
    
    Set Me.vsFlexGrid1.DataSource = temprecord
    Set temprecord = New Recordset
    temprecord.Open "select allocate_formcode.date, allocate_formcode.formcode, Shop_Dossier.name, Shop_Dossier1.name AS Expr1, allocate_formcode.number, allocate_formcode.allocatefromflag, allocate_formcode.allocatetoflag " _
     & " from allocate_formcode LEFT OUTER JOIN Shop_Dossier Shop_Dossier1 ON allocate_formcode.allocateto = Shop_Dossier1.code LEFT OUTER JOIN Shop_Dossier ON allocate_formcode.allocatefrom = Shop_Dossier.code where allocatefromflag=0 or allocatetoflag=0", GetConnect(), adOpenKeyset, adLockOptimistic

    Set Me.vsFlexGrid2.DataSource = temprecord
        Me.vsFlexGrid2.Cell(flexcpText, 0, 1) = "调货日期"
    Me.vsFlexGrid2.Cell(flexcpText, 0, 2) = "调货单号"
    Me.vsFlexGrid2.Cell(flexcpText, 0, 3) = "调出点"
    Me.vsFlexGrid2.Cell(flexcpText, 0, 4) = "调入点"
    Me.vsFlexGrid2.Cell(flexcpText, 0, 5) = "调货数量"
    Me.vsFlexGrid2.Cell(flexcpText, 0, 6) = "是否调出"
    Me.vsFlexGrid2.Cell(flexcpText, 0, 7) = "是否调入"
    Me.vsFlexGrid1.Cell(flexcpText, 0, 1) = "出货单号"
    Me.vsFlexGrid1.Cell(flexcpText, 0, 2) = "出货地点"
    Me.vsFlexGrid1.Cell(flexcpText, 0, 3) = "出货日期"
    Me.vsFlexGrid1.Cell(flexcpText, 0, 4) = "出货数量"

    
End Sub

Private Sub 报表_Click(Index As Integer)
    Dim rep As frmQryReport, rptname As String
Select Case Index
 Case 0
    rptname = "调货异常"
    Set rep = New frmQryReport
    rep.SetReportName rptname
    
    rep.AddText "Head", "", "深圳珍兴鞋业有限公司|调货异常|^^D^^T", ""
    
    rep.AddText "Foot", "", "|第 ^^P 页    共 ^^A 页|", ""
   ' rep.AddText "Top", "C", " ", "|26|"
  '  rep.AddText "Top", "L", " ", ""
    rep.AddFlex vsFlexGrid2
    rep.Show vbModal
 Case 1
    rptname = "进货异常"
    Set rep = New frmQryReport
    rep.SetReportName rptname
    rep.AddText "Head", "", "深圳珍兴鞋业有限公司|进货异常|^^D^^T", ""
    
    rep.AddText "Foot", "", "|第 ^^P 页    共 ^^A 页|", ""
 '   rep.AddText "Top", "C", " ", "|26|"
 '   rep.AddText "Top", "L", " ", ""
    rep.AddFlex vsFlexGrid1
    rep.Show vbModal
 End Select
End Sub
Public Function GetConnecta() As ADODB.Connection
On Error GoTo err_fun
    If cna.State = 0 Then
        cna.CursorLocation = adUseClient
        cna.CommandTimeout = 300
        cna.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=\\Harson\program\HARSON\sell.mdb"
    End If
    Set GetConnecta = cna
exit_fun:
    Exit Function
err_fun:
    MsgBox "数据库不能连接？" & Chr(13) & Err.Number & ": " & Err.Description
    End
End Function
Public Function GetConnectb() As ADODB.Connection
On Error GoTo err_fun
    If cnb.State = 0 Then
        cnb.CursorLocation = adUseClient
        cnb.CommandTimeout = 300
        cnb.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=\\Harson\program\HARSON\harson_stock.mdb"
    End If
    Set GetConnectb = cnb
exit_fun:
    Exit Function
err_fun:
    MsgBox "数据库不能连接？" & Chr(13) & Err.Number & ": " & Err.Description
    End
End Function